VBA打开Excel文件并将工作表1数据粘贴到当前工作簿中的"RRimport"工作表中

The*_*yst 5 excel vba excel-vba

好吧,我有一个当前的工作簿(原始工作簿)与几个表格.我想打开一个现有的工作簿(数据工作簿)并复制'数据工作簿'的工作表1中的所有内容,然后将所有内容粘贴到'原始工作簿'的工作表"RRimport"中.在此过程结束时,我想关闭"数据工作簿"到目前为止,我有以下代码,但它现在在我的工作表的名称"ARGimport"之后粘贴了一个工作表:

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
Run Code Online (Sandbox Code Playgroud)

感谢rdhs的帮助,我能够解决这个问题.更新和工作代码如下:

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
Run Code Online (Sandbox Code Playgroud)

Che*_*hel 7

这样做你想要的吗?

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
Run Code Online (Sandbox Code Playgroud)