consolidate workbooks to pull particular columns

pcorpz

Active Member
Joined
Oct 29, 2004
Messages
323
Hi Guys! The macro I am using works great. It consolidates all workbooks found in a folder. They all have the same header. What if, I only want certain columns pulled, instead of the whole header. I only want to pull columns B,G,H,I,L,N,O,Q,R,S,W,AF,AH, and AI? Can it be done?
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

pcorpz

Active Member
Joined
Oct 29, 2004
Messages
323
Code:
Option Explicit
Function PickFolder(strStartDir As Variant) As String
    Dim SA As Object, F As Object
    Set SA = CreateObject("Shell.application")
    Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
    If (Not F Is Nothing) Then
        PickFolder = F.items.Item.Path
    End If
    Set F = Nothing
    Set SA = Nothing
End Function

Sub CopySheetFromMultipleFiles()

    Dim lrow As Long
    Dim Hdrs As Long
    Dim NumCols As Long
    Dim ffc As Long
    Dim i As Long
    Dim R As Integer
    Dim WBn As String
    Dim rng As Range
    Dim WB As Workbook
    Dim WBr As Range
    Dim WBlstrw As Long
    Dim CurWks As Worksheet
    Dim CurWksLrow As Long
    Dim strStartDir As String
    Dim UserFile As String
    Dim Sht As Worksheet

    On Error Resume Next

    UserFile = PickFolder(strStartDir)
    If UserFile = "" Then
        MsgBox "Canceled"
        Exit Sub
    End If

    'CurWks will always refer to the Summary worksheet you are creating
    Set CurWks = ActiveWorkbook.Worksheets("Summary")

    Application.ScreenUpdating = False

    'Clear out the Summary worksheet
    CurWks.Activate
    With CurWks
        CurWksLrow = .Cells(Rows.Count, "A").End(xlUp).Row
        If CurWksLrow > 1 Then
            .Cells(2, 1).Resize(CurWksLrow - 1, 1).EntireRow.Delete
        End If
    End With

    lrow = 1
    Hdrs = 1
    With Application.FileSearch
        .SearchSubFolders = True
        .NewSearch
        .Filename = ".xls"
        .LookIn = UserFile
        .FileType = msoFileTypeExcelWorkbooks
        .Execute

        ffc = .FoundFiles.Count

        For i = 1 To ffc
            'WB will always refer to the source Workbook that you
            'are interrogating at the time

            Set WB = Application.Workbooks.Open(Filename:=.FoundFiles(i))
            
            If i = 1 Then
                NumCols = WB.Sheets(1).UsedRange.Column - 1 + _
                          WB.Sheets(1).UsedRange.Columns.Count
            End If

            Application.StatusBar = "Currently Processing file " & i & " of " & ffc

            WBn = WB.Name
            WBlstrw = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

            'Copy the data across
            CurWks.Cells(lrow + 1, "B").Resize(WBlstrw - Hdrs, NumCols).Value = _
            WB.Worksheets(1).Range("A2").Resize(WBlstrw - Hdrs, NumCols).Value

            'Put the filename in the first Col as an index value
            CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs, 1).Value = WBn
            lrow = lrow + (WBlstrw - Hdrs)

            WB.Close savechanges:=False
        Next
    End With

    Set WB = Nothing
    Set CurWks = Nothing

    Application.ScreenUpdating = True
    Application.StatusBar = False

End Sub
 

Forum statistics

Threads
1,181,724
Messages
5,931,688
Members
436,798
Latest member
spprtpplcm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top