Tip Printed from ExcelTip.com
Copy a column or columns from each workbook in a folder using VBA in Microsoft Excel

VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel



Remember Excel have only 256 columns
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