首页 文章

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

提问于
浏览
4

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

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

感谢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

1 回答

  • 6

    这样做你想要的吗?

    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
    

相关问题