Returning Data from multiple Worksheets

[Johnboy1]

Hi Friends,

I’m not sure if this is possible using standard Pivots or Functions, but if it is then I know someone on here will have the solution.

Basically I would like Excel to return rows of Data based on a single Criteria, but with the difficulty of being across multiple Worksheets (or Tabs in this example).

See below example Image of three Work Tabs (sheet 1 to 3) contain the rows of Data.
I need your magic solution to seamlessly return ALL rows from each individual Tab that contains the word “Ford” (as the last image shows)

NOTE: If easier, I can change any of the columns around, so for example the ‘Car’ make is in the first Column (A)

Thanks for any thoughts and solutions.

J

 

[vcoolio]

Hello JohnBoy,

See if the following VBA code does the task for you:-

Private Sub Worksheet_Change(ByVal Target As Range)
        
        Dim ws As Worksheet, sh As Worksheet
            
        If Intersect(Target, Range("F2")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

        Set sh = Sheets("Result")
        sh.Range("A4", sh.Range("D" & sh.Rows.Count).End(xlUp)).ClearContents
        
For Each ws In Worksheets
        If ws.Name <> "Result" Then
With ws.[A3].CurrentRegion
        .AutoFilter 2, Target.Value
        .Offset(1).Copy sh.Range("A" & Rows.Count).End(3)(2)
        .AutoFilter
End With
        End If
Next ws

Application.ScreenUpdating = True

End Sub

I've assumed, based on the images you have supplied, that:-

- Data in each sheet starts in Row4 with headings in Row3.
- Cell F2 in the "Result" sheet has a data validation drop down list of vehicle types.

When a vehicle type is selected from the drop down list, e.g. Ford, the relevant rows of data from each sheet will be transferred to the "Result" sheet.

This code is a Worksheet_Change event code and needs to be placed in the "Result" sheet module. To implement the code:-

- Right click on the "Result" sheet tab.
- Select "View Code" from the menu that appears.
- Paste the above code in the big white code field that then appears.

I hope that this helps.

Cheerio,
vcoolio.

 

[Johnboy1]

Hi Vcoolio,

Your VBA code has worked perfectly for the example I provided with thanks.
I'm new to VBA coding, so could you kindly show how I can obtain this same result, but from a difference work file rather then a different tab (in the same work file).?

So change 'Worksheets' to 'filename1', 'filename2', 'filename3' etc..?

Thanks again
x

 

[vcoolio]

Hello JohnBoy,

Do you mean that you'd like to select a workbook from a list of workbooks (from a drop down?) and then do the above procedure in the selected workbook then select another from the drop down etc. etc.....

Cheerio,
vcoolio.

 

[Johnboy1]

Hi Vcoolio,
And hope you had a good weekend.

A Workbook drop down would be good IF you could select a range of Workbooks at a time (so it would return the data from all of the Workbooks selected on the drop down).
But if easier, the VBA code could have preset Workbooks to check each time (so no drop down and each time it would return the data from Workbook 1, 2 and 3 or as many as I can add).

The data of each Workbook will be held with the First Tab which I can rename as required.

Thanks heaps
J

 

[vcoolio]

Hello JohnBoy,

Lets see if this works for you. This code will work based on a file selection and a vehicle selection from two drop downs in your main workbook:-

Sub WBDataTransfer()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim stgF As String, stgP As String, vSearch As String
    Dim lr As Long, nr As Long
    Dim wb As Workbook
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1") [COLOR=#0000ff]'---->Change sheet name to suit.[/COLOR]
    Dim sh As Worksheet
    vSearch = ws.Range("D1")

   [COLOR=#ff0000] stgP = "C:\Users\YOUR FILEPATH HERE\" '---->Place your file path here.[/COLOR]
    stgF = Dir(stgP & "\*.xlsx")

    stgF = Range("A1")
    Set wb = Workbooks.Open(stgP & "\" & stgF)
    stgF = Dir()

For Each sh In wb.Worksheets
        With sh.[A1].CurrentRegion
                .AutoFilter 2, vSearch
                .Offset(1).EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
                .AutoFilter
                lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                nr = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row + 1
                ws.Range("J" & nr & ":J" & lr) = wb.Name
                ws.Columns(10).AutoFit
        End With
Next sh

wb.Close Save = False

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

As I've had to create a few dummy files to test with, I've made the following assumptions:-

- Data from each source worksheet in each source workbook starts in Row2 with headings in Row1.
- The vehicle criteria is in Column B of each source sheet in each source workbook.
- In the main (or destination) workbook, A1 has a data validation drop down with the source workbook names.
- In the main (or destination) workbook, D1 has a data validation drop down with the different vehicle types.

When a vehicle type is selected from the drop down list, e.g. Ford, the relevant rows of data from each source sheet in the selected source workbook (from the drop down in A1) will be transferred to Sheet1 in the main (destination) workbook.

This code is not an event code and needs to be placed in a standard module and assigned to a button.

Please test it in a copy of your actual workbook.

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

BTW JohnBoy,

The data from each source workbook is transferred to the destination workbook (Sheet1) starting in Row5 with headings in Row4.

Also, the source workbook name is placed in Column J of the destination workbook with each transfer of data just so you know from which source workbook it came from.

Cheerio,
vcoolio.

 

[Johnboy1]

Hi vcoolio,

Once again your revised code worked perfectly with thanks, with the exception of how to select multiple source workbooks (rather then one source workbook at a time).
I don't want to keep taking your tie, but if you know of an easy fix to select multiple source workbooks (or all workbooks within a filepath) I will thank you forevermore.

Regards
J

 

[vcoolio]

Hello Johnboy,

See if the following works for you. I've rushed this a little and haven't tested it so let me know in due course how it goes:-

Sub JohnBoyTake3()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim stgF As String, stgP As String, vSearch As String
    Dim lr As Long, nr As Long, lr1 As Long
    Dim wb As Workbook
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim sh As Worksheet
    vSearch = ws.Range("D1")
[COLOR=#ff0000]
    stgP = "C:\Users\YOUR FILE PATH HERE" '---->Add your file path here.[/COLOR]
    stgF = Dir(stgP & "\*.xlsx")

Do While stgF <> vbNullString

    Set wb = Workbooks.Open(stgP & "\" & stgF)

For Each sh In wb.Worksheets
    lr1 = sh.Range("A" & Rows.Count).End(xlUp).Row
    If lr1 > 1 Then
              With sh.[A1].CurrentRegion
                      .AutoFilter 2, vSearch
                      .Offset(1).EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
                      .AutoFilter
                      lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                      nr = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row + 1
                      ws.Range("J" & nr & ":J" & lr) = wb.Name & "," & " " & sh.Name
                      ws.Columns(10).AutoFit
              End With
        End If
Next sh

wb.Close Save = False
stgF = Dir()
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

This code should loop through all the required files in the relevant folder and do the vehicle search in each sheet in those files.
I've left the vehicle search(vSearch) in cell D1. Change it to suit your workbook. No need for the data validation drop down in A1 for this code.

I hope that this helps.

Cheerio,
vcoolio.