Bonjour à tous
soit le code ci-dessous qui vient ouvrir et copier les données de la feuille Sheets1 de chaque classeur contenus dans un dossier (tous les classeurs n'ont qu'une seule feuille nommée Sheets1). Actuellement ce dernier me recopie le nom du classeur uniquement dans la première cellule de la colonne A après import des données. Je cherche à ce que ce nom de fichier soit dupliqué sur toutes les lignes. Je n'arrive pas à trouver comment écrire la ligne de code me permettant de réaliser cela. Pouvez vous m'aider svp ?
Merci
Ce qui permettrait de passer de ça
à ça
soit le code ci-dessous qui vient ouvrir et copier les données de la feuille Sheets1 de chaque classeur contenus dans un dossier (tous les classeurs n'ont qu'une seule feuille nommée Sheets1). Actuellement ce dernier me recopie le nom du classeur uniquement dans la première cellule de la colonne A après import des données. Je cherche à ce que ce nom de fichier soit dupliqué sur toutes les lignes. Je n'arrive pas à trouver comment écrire la ligne de code me permettant de réaliser cela. Pouvez vous m'aider svp ?
Merci
VB:
Sub fusionremarque()
Dim wb As Workbook
Dim targetWb As Workbook
Dim myFolder As String
Dim myFile
Dim lastRow As Long
Dim ws As Worksheet
Dim lastRowWb As Long
Dim nomfichier As String
Application.DisplayAlerts = False
' Set the directory containing the Excel files => Définir le répertoire contenant les fichiers Excel
myFolder = "C:\Users\XXXX\Mon Drive\Downloads\Fab\datas\"
' Set the target workbook => Définir le classeur cible
Set targetWb = ThisWorkbook
Set ws = targetWb.Worksheets("Sheet1") ' Assumes data is pasted to Sheet1. Change if needed. => Suppose que les données sont collées dans Sheet1. Changer si besoin
' Loop through each file in the directory => Parcourez chaque fichier du répertoire ouvre tous les fichier et sous dossier et répéter l'opération jusqu'a ce que soit faux
myFile = Dir(myFolder & "*.xlsx")
Do While myFile <> ""
' Get the first empty row in the target sheet => obtenir la premiere ligne vide dans la feuille cible
lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
lastRow2 = ws.Cells(Rows.Count, "A").End(xlDown).Row + 1
Set wb = Workbooks.Open(myFolder & myFile)
If Not wb Is Nothing Then
' Select the range A:AL from row 2 to last filled row => Sélectionnez la plage A:AL de la ligne 2 à la dernière ligne remplie
nomfichier = wb.Name
lastRowWb = wb.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row ' Assumes data is on Sheet1. Change if needed. =>Suppose que les données se trouvent sur la feuille Sheet1. Changez si nécessaire.
wb.Worksheets("Sheet1").Columns.EntireColumn.Hidden = False
wb.Worksheets("Sheet1").Rows.EntireRow.Hidden = False
wb.Worksheets("Sheet1").Range("A2:I" & lastRowWb).Copy 'Starts from row 2 => Commence à partir de la rangée 2
' Paste the data into the target workbook => Collez les données dans le classeur cible
ws.Cells(lastRow, 2).PasteSpecial xlPasteValues
ws.Cells(lastRow, 1).Value = myFile
' Clean-up => nettoyer
wb.Close False
Set wb = Nothing
Else
MsgBox "Error opening file: " & myFolder & myFile, vbCritical
End If
myFile = Dir()
Loop
Application.DisplayAlerts = True
MsgBox "Data consolidation complete!", vbInformation
End SubCe qui permettrait de passer de ça
à ça
