• 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ị.

Hãy nhớ Excel chỉ có 256 cột

Sub CopyColumn ()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim cnum As Integer

Dim i As Long

Dim a As Integer

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then

Set basebook = ThisWorkbook

cnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Columns("A:B")

a = sourceRange.Columns.Count

Set destrange = basebook.Worksheets(1).Cells(1, cnum)

sourceRange.Copy destrange

mybook.Close

cnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub

Sub CopyColumnValues()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim cnum As Integer

Dim i As Long

Dim a As Integer

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then

Set basebook = ThisWorkbook

cnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Columns("A:B")

a = sourceRange.Columns.Count

With sourceRange

Set destrange = basebook.Worksheets(1).Columns(cnum). _

Resize(, .Columns.Count)

End With

destrange.Value = sourceRange.Value

mybook.Close

cnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub