Copier une ou plusieurs lignes de chaque classeur dans un dossier en utilisant VBA dans Microsoft Excel
-
La macro copiera une partie de la première feuille de calcul de chaque fichier qui se trouve dans le dossier C: \ Data dans la première feuille de calcul de votre classeur.
-
La première macro fait une copie normale et la seconde macro copie les valeurs.
Sub CopyRow()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Data"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Rows("3:5")
a = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, 1)
sourceRange.Copy destrange
mybook.Close
rnum = i * a + 1
Next i
End If
End With
Application.ScreenUpdating = True
End Sub
Sub CopyRowValues()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Data"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Rows("3:5")
a = sourceRange.Rows.Count
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = i * a + 1
Next i
End If
End With
Application.ScreenUpdating = True
End Sub