使用 VBA 将工作簿中的工作表复制到另一个工作表

Question

编辑

我仍在尝试将 Sheet 从 Workbook 复制到 另一个 Workbook，这看起来很容易，但出于某些原因我做不到。 对于我的测试，我制作了一个非常基本的文件和代码：（我的工作表包含一个简单的表格和一个运行宏的按钮，这是我唯一的宏）

工作中

将工作表复制到同一工作簿：

Sub CopyShtInTheSameWk()
 Application.ScreenUpdating = False
 Sheets("Sheet1").Copy Before:=Sheets(1)
 Application.ScreenUpdating = True
End Sub

不工作

测试 n°1 ---------------------------------- ----------------

Sub CopyShtToAnotherWb()
 Application.ScreenUpdating = False
 Set WB = Workbooks.Open("C:\Users\33672\Desktop\test2.xlsm")
 Sheets("Sheet1").Copy Before:=WB.Sheets(1)
 WB.Close SaveChanges:=True
 Application.ScreenUpdating = True
End Sub

这个测试只是在第二个工作簿中创建了一个新工作表，但没有复制里面的内容。

测试 n°2 ---------------------------------- ----------------

Sub CopySheetToAnotherWb()
 Sheets("Sheet1").Copy Before:=Workbooks("C:\Users\33672\Desktop\test2.xlsm").Sheets(1)
End Sub

我收到了错误信息：

运行时错误 9 -> 下标超出范围

测试 n°3 ---------------------------------- ----------------

Option Explicit

Sub ExportWorksheet1()
 Const sName As String = "Sheet1"
 Const dPath As String = "C:\Users\33672\Desktop\test2.xlsm"
 Const dIndex As Long = 4 ' often not such a good idea

 Application.ScreenUpdating = False

 Dim swb As Workbook: Set swb = ThisWorkbook
 Dim sws As Worksheet: Set sws = swb.Worksheets(sName)

 Dim dwb As Workbook: Set dwb = Workbooks.Open(dPath)
 Dim dsh As Object: Set dsh = dwb.Sheets(dIndex) ' could be a chart

 sws.Copy Before:=dsh
 dwb.Close SaveChanges:=True

 Application.ScreenUpdating = True

End Sub

我在 (Workbooks.Open()) 线上收到错误消息：

运行时错误 1004 -> 抱歉，我们找不到文件“C:\Users\33672\Desktop\test2.xlsm”

测试 n°4 ---------------------------------- ----------------

只需将表格范围的粘贴数据复制到另一个工作簿的工作表即可。

Sub CopyDataIntoAnotherShtOfAnotherWb()
 Dim Wb As Workbook

 Wb = Workbooks.Open("C:\Users\33672\Desktop\test2.xlsm")
 ThisWorkbook.Worksheets("Sheet1").Range("MyTable").CurrentRegion.Copy
 Wb.Worksheets("Bilan").Range("A1").PasteSpecial(xlPasteValues)
 Wb.Close

End Sub

我在 Workbooks.Open() 行收到错误消息：

运行时错误 1004 -> 抱歉，我们找不到文件“C:\Users\33672\Desktop\test2.xlsm”

信息

• 我的文件 test2 的路径每次都是好的。

• 我正在公司计算机上使用 Excel 2016，但已经尝试在我的个人计算机上的 Microsoft 365 上执行相同的操作，没有任何区别。

Answer 1

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

• 在这个阶段，我建议您“加倍努力”：Workbook - Worksheet - Range 即使用变量。

Option Explicit

Sub ExportWorksheet1()
  
    Const sName As String = "Bilan_SAJMA"
  
    Const dPath As String = "C:\Users\33672\Documents\test01.xlsm"
    Const dIndex As Long = 4 ' often not such a good idea
  
    Application.ScreenUpdating = False

    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
  
    Dim dwb As Workbook: Set dwb = Workbooks.Open(dPath)
    Dim dsh As Object: Set dsh = dwb.Sheets(dIndex) ' could be a chart
  
    sws.Copy Before:=dsh
    dwb.Close SaveChanges:=True

    Application.ScreenUpdating = True

End Sub

• 当然，您可以这样做（不推荐）...

Sub ExportWorksheetShort()
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Bilan_SAJMA").Copy Before:= _
        Workbooks.Open("C:\Users\33672\Documents\test01.xlsm").Sheets(4)
    ActiveWorkbook.Close SaveChanges:=True
    Application.ScreenUpdating = True
End Sub

但要找到可能发生的错误背后的原因变得越来越难。

编辑

• 如果工作表非常隐藏，则必须使用以下内容（第一个版本（以上）涵盖了“简单”隐藏的工作表）。

Sub ExportWorksheet()
  
    Const sName As String = "Bilan_SAJMA"
  
    Const dPath As String = "F:\Test\2021\68019811\test01.xlsm" ' "C:\Users\33672\Documents\test01.xlsm"
    Const dIndex As Long = 4 ' often not such a good idea
  
    Application.ScreenUpdating = False

    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
  
    Dim dwb As Workbook: Set dwb = Workbooks.Open(dPath)
    Dim dsh As Object: Set dsh = dwb.Sheets(dIndex) ' could be a chart
  
    If sws.Visible = xlSheetVeryHidden Then
        sws.Visible = xlSheetVisible
        sws.Copy Before:=dsh
        sws.Visible = xlSheetVeryHidden
        'ActiveSheet.Visible = xlSheetVeryHidden ' The copy stays very hidden.
    Else
        sws.Copy Before:=dsh
    End If
    
    dwb.Close SaveChanges:=True

    Application.ScreenUpdating = True

End Sub

' To delete all sheets containing "Bilan_SAJMA" in workbook 'test01.xlsm'.
Sub DeleteSheetsNotContainingTEST()
    Dim wb As Workbook: Set wb = Workbooks("test01.xlsm")
    DeleteSheetsContaining wb, "Bilan_SAJMA"
End Sub

' To unhide all sheets in 'Thisworkbook'.
Sub UnhideSheetsTEST()
    Dim wb As Workbook: Set wb = ThisWorkbook
    UnhideSheets wb
End Sub

Sub DeleteSheetsContaining( _
        ByVal wb As Workbook, _
        ByVal StringContained As String)
    
    If wb Is Nothing Then Exit Sub
    
    Dim sh As Object
    Dim shNames() As String
    Dim n As Long
    
    For Each sh In wb.Sheets
        If InStr(1, sh.Name, StringContained, vbTextCompare) > 0 Then
            If sh.Visible = xlSheetVeryHidden Then
                sh.Visible = xlSheetVisible
            End If
            n = n + 1
            ReDim Preserve shNames(1 To n)
            shNames(n) = sh.Name
        End If
    Next sh
    
    If n = 0 Then Exit Sub
        
    Application.DisplayAlerts = False
    wb.Sheets(shNames).Delete
    Application.DisplayAlerts = True

End Sub

Sub UnhideSheets(ByVal wb As Workbook)
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If Not ws.Visible = xlSheetVisible Then
            ws.Visible = xlSheetVisible
        End If
    Next ws
End Sub

Answer 2

我终于找到了解决办法：

Sub CopyShtInOtherWb()
 Dim Wb As Workbook

 Set Wb = Workbooks.Open(ThisWorkbook.Path & "\test2.xlsm")
 ThisWorkbook.Sheets("Sheet1").Copy After:=Wb.Sheets("Sheet1")
 Wb.Close SaveChanges:=True
End Sub