Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA to Open Excel File and Paste Sheet 1 Data into "RRimport" Sheet in Current Workbook

Tags:

excel

vba

Ok so I have a current workbook (Original Workbook) with several Sheets. I would like to open an existing workbook (Data Workbook) and copy all of the contents in Sheet 1 of 'Data Workbook', then paste everything into Sheet "RRimport" of 'Original Workbook'. At the end of this process I would like to close the 'Data Workbook' So far I have the following code, however it currently pastes a new sheet right after my sheet names "ARGimport" of my Original Workbook:

Sub ImportData()

Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = ActiveWorkbook

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
        If Sheet.Visible = True Then
            Sheet.Copy After:=wb1.Sheets("ARGimport")
        End If
    Next Sheet

End If

    wb2.Close

End Sub

Thanks to the help of rdhs I was able to figure this out. Updated and working code below:

Sub ImportData()

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

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

Sheets("RRimport").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
like image 447
The Analyst Avatar asked Nov 13 '13 23:11

The Analyst


1 Answers

Does this do what you want?

Sub ImportData()

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

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

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
like image 198
Chel Avatar answered Nov 14 '22 21:11

Chel