Data Extraction Multiple Workbooks And Sheets To Master Spreadsheet

Hi All,

Refering to thread http://www.ozgrid.com/forum/showthread.php?t=135307, I have same problem and i tried to copy the same solution as provided in the mentioed thread. Either the code or the way i am following the solution is restricting me to copy the value in the desired workbook.

Can anyone have a look and make me correct please

thank you

Shido

You changed the FolderPicker dialog to a FilePicker dialog. I assume then you just want to copy from the one selected file rather than all the Excel files in a folder. If yes, then you wouldn't use the selected file name as a folder path.

    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        On Error GoTo errline
        sFolder = .SelectedItems(1)
    End With
     
    Set wsTo = ThisWorkbook.Sheets("US")
    wsTo.Activate
    Set rPaste = Application.InputBox("Enter starting cell to paste", Type:=8)
    If rPaste Is Nothing Or rPaste.Count > 1 Then Exit Sub
     
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
    End With
    On Error Resume Next
     
    With Application.FileSearch
        .NewSearch
        .LookIn = sFolder

This opens just the one selected file.

Sub search()
     
    Dim nCount As Long, wbResults As Workbook, rPaste As Range, wsTo As Worksheet, wsFrom As Worksheet, sFile As String
     
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        sFile = .SelectedItems(1)
    End With
     
    Set wsTo = ThisWorkbook.Sheets("US")
    wsTo.Activate
    On Error Resume Next
    Set rPaste = Application.InputBox("Enter starting cell to paste", Type:=8)(1)
    On Error GoTo 0
    If rPaste Is Nothing Then Exit Sub
     
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
    End With
    
    Set wbResults = Workbooks.Open(Filename:=sFile, UpdateLinks:=0)
    For Each wsFrom In wbResults.Worksheets
        With wsTo.Range(rPaste.Address)
            .Value = wsFrom.Range("B5").Value
            .Offset(, 1).Value = wsFrom.Range("B6").Value
            .Offset(, 2).Value = wsFrom.Name
            .Offset(1, 3).Resize(11).Value = wsFrom.Range("B10:B20").Value
        End With
        Set rPaste = rPaste.Offset(13)
    Next wsFrom
    wbResults.Close SaveChanges:=True
    
    With Application
        .ScreenUpdating = False: .DisplayAlerts = True: .EnableEvents = True
    End With
    
End Sub

Try this. First clear any bad data below on the US master sheet.

Sub search()
     
    Dim wbResults As Workbook, wsTo As Worksheet, wsFrom As Worksheet, sFile As String
     
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        sFile = .SelectedItems(1)
    End With
     
    Set wsTo = ThisWorkbook.Sheets("US")
     
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
    End With
    
    Set wbResults = Workbooks.Open(Filename:=sFile, UpdateLinks:=0)
    For Each wsFrom In wbResults.Worksheets
        With wsTo.Range("A" & Rows.Count).End(xlUp).Offset(1) 'Next empty row
            .Value = wsFrom.Range("D13").Value
            .Offset(, 1).Value = wsFrom.Range("R19").Value
            .Offset(, 2).Value = wsFrom.Range("V19").Value
            .Offset(, 3).Value = wsFrom.Range("AA19").Value
            .Offset(, 4).Value = wsFrom.Range("AD19").Value
            .Offset(, 5).Value = wsFrom.Range("AF19").Value
            .Offset(, 6).Value = wsFrom.Range("AK19").Value
            .Offset(, 7).Value = wsFrom.Range("AM19").Value
            .Offset(, 8).Value = wsFrom.Range("AP19").Value
        End With
    Next wsFrom
    wbResults.Close SaveChanges:=True
    
    With Application
        .ScreenUpdating = False: .DisplayAlerts = True: .EnableEvents = True
    End With
    
End Sub

Thank you once again, it really works well, This is the reason i love to be on this forum always get what i asked..... This is what i was looking for except, do not know what you mean by clearning any bad data.? do you mean to clear any Nil or alphanumeric values in the Master sheet?
Thanks once again
Cheers and keep doing good work.

In your example Disire Result.xlsx workbook, the US sheet had some bad data on it from the previous macros below the desired results.

Dear AlphaFrog,

Thanks for pointing me out to the right direction and keep it up.

Cheers

Shido