Copy Data From Specific Sheet In Workbook

[ir121973]

Hi, I wonder whether someone may be able to help me please.

I'm using the code below to allow the user to select multiple Excel files, copy a range of data before amalgamating them into a 'Master' spreadsheet.

Sub BigMerge()
Set DestWB = ActiveWorkbook
    SourceSheet = "Combined"
    StartRow = 5
    FileNames = Application.GetOpenFilename( _
    filefilter:="Excel Files (*.xls*),*.xls*", _
    Title:="Select the workbooks to merge.", MultiSelect:=True)
    If IsArray(FileNames) = False Then
    If FileNames = False Then
    Exit Sub
End If
End If
    For N = LBound(FileNames) To UBound(FileNames)
    Set WB = Workbooks.Open(Filename:=FileNames(N), ReadOnly:=True)
For Each WS In WB.Worksheets
With WS
    If .UsedRange.Cells.Count > 1 Then
    dr = DestWB.Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
    Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
    SourceSheet.Select
    .Range("A" & StartRow & ":AD" & Lastrow).Copy


    DestWB.Worksheets("Combined").Cells(dr, "A").PasteSpecial _
    Paste:=xlPasteValues, _
    Operation:=xlNone, _
    SkipBlanks:=False, _
    Transpose:=False
    Application.CutCopyMode = False
    End If
End With


Next WS


WB.Close savechanges:=False
Next N
End Sub

The problem I'm having is that out of the 'Source' workbooks there is only one sheet that I need to copy the information from, in this case it is called 'Combined'.

With the little knowledge I have I've tried to incorporate this by dding the 'SourceSheet' variable, but unfortunately when I run this I receive the following error:
Run-time error '424': Object required, and this line is highlighted as the source of the problem 'SourceSheet.Select'.

I just wondered whether someone may be able to take a look at this please and let me know where I'm going wrong?

Many thanks and kind regards

 

[JoeMo]

Try replacing that line with:

Sheets(SourceSheet).Select

your sourcesheet variable is a string name of the sheet.

 

[ir121973]

Hi, thank you very much for this. I've amended my code, and it correctly copies the data from the 'Combined' sheet, but in addition it incorrectly copies two rows from one of the other sheets in the same workbook. The incorrect sheet is number two in the range of worksheets in the 'Source' workbook.

Could you possibly tell me please what I'm doing wrong?

Many thanks and regards

 

[JoeMo]

Hi, thank you very much for this. I've amended my code, and it correctly copies the data from the 'Combined' sheet, but in addition it incorrectly copies two rows from one of the other sheets in the same workbook. The incorrect sheet is number two in the range of worksheets in the 'Source' workbook.

Could you possibly tell me please what I'm doing wrong?

Many thanks and regards

Easier to rewrite your code. See if this does what you want:

Sub BigMerge()
Dim DestWB As Workbook, WB as Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Combined"
StartRow = 5
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select the workbooks to merge.", MultiSelect:=True)
If IsArray(FileNames) = False Then
    If FileNames = False Then
        Exit Sub
    End If
End If
For N = LBound(FileNames) To UBound(FileNames)
    Set WB = Workbooks.Open(Filename:=FileNames(N), ReadOnly:=True)
    For Each WS In WB.Worksheets
        If WS.Name = SourceSheet Then
            With WS
                If .UsedRange.Cells.Count > 1 Then
                    dr = DestWB.Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
                    .Range("A" & StartRow & ":AD" & Lastrow).Copy
                    DestWB.Worksheets("Combined").Cells(dr, "A").PasteSpecial _
                    Paste:=xlPasteValues, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False
                    Application.CutCopyMode = False
                End If
            End With
            WB.Close savechanges:=False
            Exit For
        End If
    Next WS
Next N
End Sub

 

[ir121973]

Hi @JoeMo, this is absolutely brilliant, it works great.

Thank you so very much for all your time and trouble, it 's greatly appreciated.

Kind regards

 

[JoeMo]

Hi @JoeMo, this is absolutely brilliant, it works great.

Thank you so very much for all your time and trouble, it 's greatly appreciated.

Kind regards

Thanks for the feedback - glad I could help.