Kopieren einer Zeile oder Zeilen aus jeder Arbeitsmappe in einem Ordner mit VBA in Microsoft Excel
-
Das Makro kopiert einen Teil des ersten Arbeitsblatts jeder Datei im Ordner C: \ Data in das erste Arbeitsblatt Ihrer Arbeitsmappe.
-
Das erste Makro kopiert normal und das zweite Makro kopiert die Werte.
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