Open and copy the contents of another excel sheet to active workbook using VBA

[gsgurpreetsingh501]

I'm using below code for copying data from another worksheet to the active worksheet. If i give Sheet2 instead of Sheet1 (in bold), it's giving error as "Run-time error 1004: copy method of range class failed". Please note that Sheet2 exists and command button for the code is placed in Sheet1. Please help in resolving the issue

Private Sub ImportData_Click()


Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range


Set wb1 = ActiveWorkbook
Set PasteStart = [Sheet1!A1]


Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents


FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xls),")


If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)


For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet


End If


wb2.Close


End Sub

 

[Norie]

Try setting PasteStart after you've cleared 'Sheet1'.

 

[gsgurpreetsingh501]

No it's not working.

Sheets("Sheet2").Select '------1
Cells.Select '------2
Selection.ClearContents '------3

Set PasteStart = [Sheet2!A1]

In debug mode, it's showing error coming due to line 2.

 

[Norie]

That code isn't the same as the code in the original post.

Also, you don't need to select anything to work with it.

Try this.

Private Sub ImportData_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

    Set wb1 = ActiveWorkbook

    With wb1
        .Sheets("Sheet1").ClearContents
        Set PasteStart = .Sheets("Sheet1").Range("A1")
    End With

    FileToOpen = Application.GetOpenFilename _
                 (Title:="Please choose a Report to Parse", _
                  FileFilter:="Report Files *.xls (*.xls),")

    If FileToOpen = False Then
        MsgBox "No File Specified.", vbExclamation, "ERROR"
        Exit Sub
    Else
        Set wb2 = Workbooks.Open(Filename:=FileToOpen)

        For Each Sheet In wb2.Sheets
            With Sheet.UsedRange
                .Copy PasteStart
                Set PasteStart = PasteStart.Offset(.Rows.Count)
            End With
        Next Sheet

    End If

    wb2.Close

End Sub

 

[gsgurpreetsingh501]

Thanks a lot for your support