• 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