将 1 个工作簿中的表复制到另一个工作簿答案

【问题标题】：copy a table in 1 workbook to another workbook将 1 个工作簿中的表复制到另一个工作簿
【发布时间】：2026-02-21 19:40:01
【问题描述】：

我是 vba 编码的新手。我不知道这是否可行，但您能否将我的一张工作表中的表格（每日）复制到另一个工作簿。我希望打开第二个工作簿，将选定的数据范围粘贴到第二个工作簿的表格中，然后保存并关闭第二个工作簿。

非常感谢任何帮助。

Private Sub CommandButton3_Click()

Dim ws As Sheets
Set ws = Sheet4
Dim tbl As ListObject
Dim dt As Integer
Dim line As String
Dim shift As String
Dim prod As Integer
Dim mydata As Workbook
Dim FileName As String
Dim lastrow As Long


FileName = "C:\Users\john.bauer\Desktop\Archive.xlsx"



Set tbl = ws.ListObjects("Daily")
With tbl
    Range(1).Value = dt
    Range(2).Value = line
    Range(3).Value = shift
    Range(4).Value = prod
End With



Set wb = wookbooks.Open(FileName).wb.woorksheet("Table").Active

lasrow = ActiveSheet.Cells(Row.Count, 1).End(x1up).Rows

Active.Cells(lastrow + 1, 1).Select

dt.Paste
Active.Cells(lastrow + 1, 2).Select
line.Paste
Active.Cells(lastrow + 1, 3).Select
shift.Paste
Active.Cells(lastrow + 1, 4).Select
prod.Paste

ActiveWorkbook.Save
ActiveWorkbook.Close savechanges = True

【问题讨论】：

我用我目前拥有的代码更新了我的原始帖子
那么你的代码有什么问题？请注意，当您使用 With 语句时，您需要在前面添加一个点来引用对象，例如.Range ...。你会从阅读how to avoid using select 中受益，选择/激活通常是不好的做法，你应该避免它。
它表示方法或数据成员未找到并突出显示这一行。
由于拼写错误wookbook 而不是Workbooks，其中许多行无法执行。用数字一代替xlup中的字母L，lasrow代替lastrow...
设置 tbl = ws.ListObjects("Daily")

标签： excel vba copy-paste transfer excel-tables

【解决方案1】：

备份表数据

调整常量部分中的值（例如，从未提及源工作表名称 (swsName)）。
如果您要复制表的所有列，但不小心只有四列，则应删除行 Const sfCols As Long = 4 和 .Resize(, sfCols) 部分。

标准模块，例如Module1

Option Explicit

Sub BackupDaily()
    
    ' Constants
    
    ' Source
    Const swsName As String = "Sheet1"
    Const stblName As String = "Daily"
    Const sfCols As Long = 4
    ' Destination
    Const dFilePath As String = "C:\Users\john.bauer\Desktop\Archive.xlsx"
    Const dwsName As String = "Table"
    Const dfCol As String = "A"
    
    ' References
    
    ' Source
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Worksheets(swsName)
    Dim stbl As ListObject: Set stbl = sws.ListObjects(stblName)
    Dim srg As Range: Set srg = stbl.DataBodyRange.Resize(, sfCols)
    ' Destination
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' Workbooks.Open(dFilePath)
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    Dim dfCell As Range
    Set dfCell = dws.Cells(dws.Rows.Count, dfCol).End(xlUp).Offset(1)
    Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
    
    ' Do
    
    ' Copy (by assignment)
    drg.Value = srg.Value
    ' Save & Close
    dwb.Close SaveChanges:=True
    ' Inform user.
    MsgBox "Table data backed up.", vbInformation, "Backup Daily"
    
End Sub

表格模块，例如Sheet1（或命令按钮的任何位置

Option Explicit

Private Sub CommandButton3_Click()
    BackupDaily
End Sub

【讨论】：