1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
| Sub copierColler()
Dim recherche As String
Dim Line As Range
Dim Num As Integer
Dim deligne As Integer
Dim derniereLigne As Integer
For j = 1 To 12
For i = 1 To 10
'entête de tableau à rechercher
recherche = Worksheets("Feuil" & j).Cells(1, i)
'copier la colonne
derniereLigne = Worksheets("Feuil" & j).Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Feuil" & j).Range(Cells(2, i), Cells(derniereLigne, i)).Copy
'recherche la colonne du même entête
Set Line = ThisWorkbook.Worksheets("Combined").Rows("1").Find(What:=recherche, LookIn:=xlValues, lookat:=xlWhole)
If Not Line Is Nothing Then
Num = Line.Column
'coller la colonne
deligne = Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Combined").Range(Cells(deligne, Num), Cells(deligne + derniereLigne, Num)).Paste
End If
Next i
Next j
End Sub |
Partager