Bonjour
En partant de ce post :
https://www.excel-downloads.com/thr...r-plusieurs-documents-excel-en-un-seul.98695/
La macro ci-dessous me conviendrait mais mes connaissances du VBA ne me permettent pas de l'adapter.
J'ai plusieurs classeurs de données dont je voudrais copier ces données dans un autre classeur avec quelques adaptions.
Classeurs de données entête en D1 et données en B3 à B303 (ex data1.xlsx, data2.xlsx, etc)
Classeur de compilation (sur une seule feuille) chaque colonne récupère les données des autres classeurs
L'entête des classeurs qui est en D1 est à copier dans le classeur de compilation en C1 pour le 1er classeur puis D1 pour 2ème, etc...
Les données des classeurs qui sont en B3 à B303 sont à copier dans le classeur de compilation en C4 à C304 pour le 1er classeur puis en D4 à D304 pour 2ème, etc...
J'espère avoir été assez clair ,-)
A quoi sert le ''sup'' de la 3ème ligne ? il me donne une erreur, ça fonctionne en le supprimant.
Merci beaucoup pour votre aide
Sub consolide()
ChDir ThisWorkbook.Path
Set classeurMaitre = ThisWorkbook
' sup
'Ajoute une feuille à ce classeur
Set feuille = classeurMaitre.Sheets.Add(After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count))
feuille.Name = "Import"
compteur = 0
'parcourir les classeurs de ce répertoire
nf = Dir("*.xls")
Do While nf <> ""
If nf <> classeurMaitre.Name Then
compteur = compteur + 1
Workbooks.Open Filename:=nf
With ActiveWorkbook.Sheets(1).UsedRange
If compteur = 1 Then
'si compteur = 1 copie avec la ligne d'entête de la plage
.Copy Destination:=feuille.Cells(Rows.Count, 1).End(xlUp)
Else
'sinon copie sans l'entête
With .Offset(1).Resize(.Rows.Count - 1)
.Copy Destination:=feuille.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
End If
End With
Workbooks(nf).Close False
End If
nf = Dir
Loop
End Sub