Copy or Transpose multiple columns into a single column.

[harzer]

Hello everyone,
I allow myself to submit my problem since I do not know how to provide a solution to my problem
What I want to do is transpose or copy the following cells:
1. Non-empty cells will be copied, which means that empty cells will not be copied.
2. Visible cells, which means that hidden cells will not be copied.
3. Cells that contain formulas will not be copied either.
4. In line number 1 we have the headers.
We will copy the cells in column "D" from cell "D2" of the following sheets: "Classe A", "Classe B", "Classe C", "Classe D", "Classe E", "Classe F", "Classe AK", "Classe BK", "Classe CK", "Classe A4T", "Classe B4T", "Classe C4T", "Classe AK4T", "Classe BK4T" and "Classe CK4T", 15 sheets in total, to paste them in column "A" one below the other, in the "Liste" sheet from cell "A2".
Column "D" of the source sheets contains first and last names, it may happen that one or more columns in the source sheets do not contain data from cells "D2", please take this detail into account in your programming.
When all the cells in columns "D" of the source sheets are copied into column "A" of the "Liste" sheet, we will remove the duplicates and sort the remaining list in ascending order.
I would like to ask you for a VBA code that uses LBound or UBound so that it is fast.
Unless I am mistaken, I have the desired result in column "A" of the "Liste" sheet
I remain at your disposal if you need any further information.
Thank you for your cooperation.

sheets("Classe A")

MaListe.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1		Bague	Cage	Eleveurs	Stam	Hrl	Kn	Wa	Holk	Fl	Sch	Klk	Kl	Krol	Imp	TN	Total
2	CH	5	97	Perez Renée	1247	23	23		17	18					9		90
3	PH	1	2	Jean Pierre	254	22	22		14	17					8		83
4	1	2	4	Dupuy Francois	369	21	21		15	16					8		81
5	2	3	6	Guillot Louis	444	21	20		14	15					7		77
6	3	4	13	Hubert Joseph	54B	20	24		15	14					7		80
8	5	6	87	Carpentier Antoine	478F	23	22		14	14					7		80
9	6	7	58	Sanchez Charles	HUN25	22	21		13	14					7		77
10	7	8	14	Dupuis Nicolas	KLM21	21	21		13	13					7		75
11	8	9	69	Moulin Etienne	GTR54	21	20		12	13					7		73
12	9	10	25	Louis Guillaume	12	20	20		12	12					7		71
13	10	11	98	Deschamps Michel	5	20	20		11	12					7		70
14	11	12	32	Huet Andre	65	19	20		11	12					7		69
15	12	13	47		822												0
16	13	14	147	Perez Renée	BF45												0
17	14	15	258	Boucher Pauline	LO54												0
18	15	16	456	Fleury Auguste	GFD69												0
19	16	17	987	Royer Jules	HGY25												0
20	17	18	42	Klein Georges	SFR74												0
21	18	19	66	Jacquet Julien	HYO56												0
22	19	20	55	Adam Philibert	JU124												0
23	20	21	44	Paris Fernand	XWQ78												0
24	21	22	77	Perez Renée	MPK58												0
25	22	23	33	Marty Edmond	VBF98												0
26	23	24	22	Aubry Toussaint	VCD254												0
27	24	25	11	Guyot Jehan	QSA11												0
28	25	26	774	Carre Anthoine	DEZ47												0
29	26	27	325	Charles Germain	HGT47												0
30	27	28	428	Renault Clement	BNH11												0
31	28	29	761	Charpentier Armand	CDQ85												0
32	29	30	455	Menard Constant	POI47												0
33	30	31	98	Maillard Franciscus	VFD69												0
34	31	32	111	Aubry Toussaint	NNN47												0
35	32	33	287	Bertin Arthur	NBV47												0
36	33	34	473		MP47O												0
37	34	35	128	Herve Olivier	XXW54												0
38	35	36	411	Schneider Daniel	POI73												0
39	36	37	577	Fernandez Marin	BBB74												0
40	37	38	665	Le Gall Baptiste	MPO41												0
41	38	39	998	Collet Marius	KNN03												0
42	39	40	225	Leger Elie	BHG74												0
43	40	41	177	Bouvier Isidore	JUY58												0
44	41	42	669	Maillard Franciscus	POW82												0
45	42	43	331	Guyot Jehan	JUY65												0
46	43	44	124	Bertin Arthur	POP11												0
Classe A

Cell Formulas
Range	Formula
D2	D2	=D16
D44,D46	D44	=D33
D45	D45	=D27
Q8:Q46,Q2:Q6	Q2	=SUM(F2:P2)

Sheets("Classe B")

MaListe.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1		Bague	Cage	Eleveurs	Stam	Hrl	Kn	Wa	Holk	Fl	Sch	Klk	Kl	Krol	Imp	TN	Total
2	CH	5	97	Perez Renée	1247	23	23		17	18					9		90
3	PH	1	2	Jean Pierre	254	22	22		14	17					8		83
4	1	2	4	Dupuy Francois	369	21	21		15	16					8		81
5	2	3	6	Guillot Louis	444	21	20		14	15					7		77
6	3	4	13	Hubert Joseph	54B	20	24		15	14					7		80
7	4	5	22	Boucher Pauline		24	23		15	14					5		81
8	5	6	87	Carpentier Antoine	478F	23	22		14	14					7		80
9	6	7	58	Sanchez Charles	HUN25	22	21		13	14					7		77
10	7	8	14	Dupuis Nicolas	KLM21	21	21		13	13					7		75
11	8	9	69	Moulin Etienne	GTR54	21	20		12	13					7		73
12	9	10	25	Louis Guillaume	12	20	20		12	12					7		71
13	10	11	98	Deschamps Michel	5	20	20		11	12					7		70
14	11	12	32	Huet Andre	65	19	20		11	12					7		69
15	12	13	47		822												0
16	13	14	147	Perez Renée	BF45												0
17	14	15	258	Boucher Pauline	LO54												0
18	15	98	166	Peters Léon													0
Classe B

Cell Formulas
Range	Formula
Q2:Q18	Q2	=SUM(F2:P2)

Sheets("Liste")

MaListe.xlsm
	A
1	Eleveurs
2	Adam Philibert
3	Aubry Toussaint
4	Bertin Arthur
5	Boucher Pauline
6	Bouvier Isidore
7	Carpentier Antoine
8	Carre Anthoine
9	Charles Germain
10	Charpentier Armand
11	Collet Marius
12	Deschamps Michel
13	Dupuis Nicolas
14	Dupuy Francois
15	Fernandez Marin
16	Fleury Auguste
17	Guillot Louis
18	Guyot Jehan
19	Herve Olivier
20	Hubert Joseph
21	Huet Andre
22	Jacquet Julien
23	Jean Pierre
24	Klein Georges
25	Le Gall Baptiste
26	Leger Elie
27	Louis Guillaume
28	Maillard Franciscus
29	Marty Edmond
30	Menard Constant
31	Moulin Etienne
32	Paris Fernand
33	Perez Renée
34	Peters Léon
35	Renault Clement
36	Royer Jules
37	Sanchez Charles
38	Schneider Daniel
Liste

 

[DanteAmor]

Try this:

Sub list_names()
  Dim sh As Worksheet
  Dim c As Range
  Dim dic As Object
  Dim arr As Variant, itm As Variant
  Dim sNames As String
  
  arr = Array("Classe A", "Classe B", "Classe C", "Classe D", "Classe E", _
              "Classe F", "Classe AK", "Classe BK", "Classe CK", "Classe A4T", _
              "Classe B4T", "Classe C4T", "Classe AK4T", "Classe BK4T", "Classe CK4T")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each itm In arr
    If Evaluate("ISREF('" & itm & "'!A1)") Then
      Set sh = Sheets(itm)
      For Each c In sh.Range("D2", sh.Range("D" & Rows.Count).End(3)).SpecialCells(xlVisible)
        If c.Value <> "" And Not c.HasFormula Then
          dic(c.Value) = Empty
        End If
      Next
    Else
      sNames = sNames & itm & vbCr
    End If
  Next
  
  With Sheets("Liste")
    .Range("A2:A" & Rows.Count).ClearContents
    .Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.keys)
    .Range("A2").Resize(dic.Count).Sort .Range("A2"), xlAscending, Header:=xlNo
  End With
  
  If sNames <> "" Then
    MsgBox "These sheets do not exist:" & vbCr & sNames
  End If
End Sub

 

[harzer]

Hello DanteAmor,
Thank you for your feedback and the proposed code, the latter works very well and meets my expectations.
Well done and thank you.