• Macro sẽ sao chép một phần của trang tính đầu tiên của mọi tệp nằm trong thư mục C: \ Data vào trang tính đầu tiên trong sổ làm việc của bạn.

  • Macro đầu tiên thực hiện sao chép bình thường và macro thứ hai sao chép các giá trị.

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