Bonjour,
J'aimerais modifié la macro ci-dessous qui me sert à importer plusieurs fichiers.xls depuis un même répertoire dans un seul classeur.xls et copier les feuill 1 à la suite sur feuille 2, 3 etc. Maintenant, je bloque un peu et j'aimerais aussi qui'il copie le nom des fichiers. Pourriez-vous m'aider à ce sujet ?
Ci-dessous en rouge l'endroit ou je bloque.
Sub Importspreadsheets_6()
Dim Ligne As Long, Lig As Long
Dim tabStr() As String
Dim ws As Worksheet, wbk As Workbook, Temp$, Rep$, Fic$
'////////////////////////////////////////////////////////
Set ws = ThisWorkbook.Sheets(1) ' <- Feuille de copie des données
Rep = "H:\David Jones\New Folder\": Fic = "*.xls" ' <-Désignation du dossier/type de fichier
Temp = Dir(Rep & Fic) ' <- ici on parcourt le dossier
Application.ScreenUpdating = False ' <- ici je fige l'écran
Do While Temp <> ""
Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
For Each Sheet In wbk.Sheets
Lig = wbk.Sheets(1).UsedRange.Rows.Count
Ligne = ws.[A65536].End(xlUp).Row
With ThisWorkbook
Sheets(1).Copy after:=.Sheets(.Sheets.Count)
"Renomer la feuille avec le nom du fichier importés"
End With
wbk.Close '<- fermeture du classeur
Next Sheet
Temp = Dir
Loop
Rows(1).Delete '<- suppression 1ère ligne (esthétique)
Set wbk = Nothing '<- reset variable WBk
Application.ScreenUpdating = True '<- ici on défige l'écran
End Sub
Merci d'avance.
Soleil11😀
J'aimerais modifié la macro ci-dessous qui me sert à importer plusieurs fichiers.xls depuis un même répertoire dans un seul classeur.xls et copier les feuill 1 à la suite sur feuille 2, 3 etc. Maintenant, je bloque un peu et j'aimerais aussi qui'il copie le nom des fichiers. Pourriez-vous m'aider à ce sujet ?
Ci-dessous en rouge l'endroit ou je bloque.
Sub Importspreadsheets_6()
Dim Ligne As Long, Lig As Long
Dim tabStr() As String
Dim ws As Worksheet, wbk As Workbook, Temp$, Rep$, Fic$
'////////////////////////////////////////////////////////
Set ws = ThisWorkbook.Sheets(1) ' <- Feuille de copie des données
Rep = "H:\David Jones\New Folder\": Fic = "*.xls" ' <-Désignation du dossier/type de fichier
Temp = Dir(Rep & Fic) ' <- ici on parcourt le dossier
Application.ScreenUpdating = False ' <- ici je fige l'écran
Do While Temp <> ""
Set wbk = Workbooks.Open(Rep & Temp) '<- ici on ouvre le classeur trouvé
For Each Sheet In wbk.Sheets
Lig = wbk.Sheets(1).UsedRange.Rows.Count
Ligne = ws.[A65536].End(xlUp).Row
With ThisWorkbook
Sheets(1).Copy after:=.Sheets(.Sheets.Count)
"Renomer la feuille avec le nom du fichier importés"
End With
wbk.Close '<- fermeture du classeur
Next Sheet
Temp = Dir
Loop
Rows(1).Delete '<- suppression 1ère ligne (esthétique)
Set wbk = Nothing '<- reset variable WBk
Application.ScreenUpdating = True '<- ici on défige l'écran
End Sub
Merci d'avance.
Soleil11😀
