Question

我有两个excel电子表格我需要复制带有数据的工作表并将其粘贴到另一个工作簿。

执行代码时不将表单复制到另一个工作簿。如果我在目标工作簿中修改了我的代码并执行了三次或两次复制。有人可以帮助我。

代码：

Dim filter As String
Dim caption As String
Dim RB_Filename As String
Dim RB_workbook As Workbook
Dim Master_workbook As Workbook
Dim RB_sheet As Worksheet
Dim Master_sheet As Worksheet
Dim errSheet As Worksheet
Dim errSheetExists As Boolean
Dim StatusSheet As Worksheet
Dim sourceStatusSheet As Worksheet


Set Master_workbook = Application.ActiveWorkbook

' get the  workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
MsgBox "Please insert file "
RB_Filename = Application.GetOpenFilename(filter, , caption)

'If Cancel then exit
If TypeName(RB_Filename) = "Boolean" Then
Exit Sub
End If

Set RB_workbook = Workbooks.Open(RB_Filename
Set RB_sheet = RB_workbook.Worksheets("Holger")
RB_sheet.Activate
RB_sheet.Select
For Each sourceStatusSheet In Master_workbook.Worksheets
            If sourceStatusSheet.Name = "Holger" Then
                Windows(Master_workbook.Name).Activate
                Master_workbook.Sheets(sourceStatusSheet.Name).Select

                'Worksheets(i).Cells.ClearContents
                 sourceStatusSheet.Delete
                 RB_sheet.Copy After:=Master_workbook.Sheets(Master_workbook.Sheets.Count)
                 Master_workbook.Activate

            Exit For
            End If
        Next
If TypeName(RB_sheet) = "Boolean" Then
Exit Sub
End If
RB_workbook.Close

End Sub

Answer 1

有时最好只是尝试.Delete无论是否存在。 On Error Resume Next可以跳过尝试删除不存在的内容，Application.DisplayAlerts可以跳过任何恼人的确认（如果有）。

Sub ws_Copy()
    Dim filter As String
    Dim caption As String
    Dim RB_Filename As String
    Dim RB_workbook As Workbook
    Dim Master_workbook As Workbook
    Dim RB_sheet As Worksheet
    Dim Master_sheet As Worksheet
    Dim errSheet As Worksheet
    Dim errSheetExists As Boolean
    Dim StatusSheet As Worksheet
    Dim sourceStatusSheet As Worksheet


    Set Master_workbook = ActiveWorkbook

    ' get the  workbook
    filter = "Text files (*.xlsx),*.xlsx"
    caption = "Please Select an input file "
    MsgBox "Please insert file "
    RB_Filename = Application.GetOpenFilename(filter, , caption)

    'If Cancel then exit
    If TypeName(RB_Filename) = "Boolean" Then Exit Sub

    Set RB_workbook = Workbooks.Open(RB_Filename, ReadOnly:=True)
    Set RB_sheet = RB_workbook.Worksheets("Holger")

    With Master_workbook
        'first remove the Holger ws from Master (if it exists)
        On Error Resume Next
        Application.DisplayAlerts = False
        .Worksheets("Holger").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

        'copy the Holger ws to Master
        RB_sheet.Copy After:=.Sheets(.Sheets.Count)
    End With

    RB_workbook.Close savechanges:=False

End Sub

将工作表从一个Excel工作簿复制到另一个工作簿

1 个答案: