excel - VBA:将数据复制到现有的列表对象中
问题描述
我收到这种类型的错误:
我的目标是从另一个工作表(在另一个工作簿中)复制数据并将其粘贴到我的主工作簿/工作表中的现有表中。首先,我清除数据,然后插入新数据。我循环浏览的每张工作表在我的主工作簿中都有相应的工作表。每张表只有 1 个列表对象(表)。到目前为止,已实现以下代码(这似乎与我当前的问题有关):
Option Explicit
'Declaring all public variables and constants
' Strings
Public InputPath As String
Public OutputPath As String
Public DataFile As String
' Integers
Public i As Integer
Public j As Integer
Public k As Integer
Public fr As Integer
Public fc As Integer
Public lr As Integer
Public lc As Integer
' Workbooks and worksheets
Public Wkb As Workbook
Public Ws As Worksheet
Public Tws As Worksheet
'Objects, ranges, arrays
Public NewData As Range
Public tbl As ListObject
Sub main()
' This sub is used to set public variables
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
InputPath = "MyInputPath\"
OutputPath = "MyOutputPath\"
DataFile = "MyFile.xlsx"
Call UpdateData
ThisWorkbook.Sheets(1).Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub UpdateData()
' This sub updates data (fetching new sheets from generated Excel-file)
' Updating sheets
Application.DisplayAlerts = False
Workbooks.Open Filename:=OutputPath & DataFile
Set Wkb = Workbooks(DataFile)
With Wkb
k = .Worksheets.Count
For i = 1 To k ' Number of default worksheets to all worksheets
For Each Ws In ThisWorkbook.Worksheets
If .Worksheets(i).Name = Ws.Name Then ' Finding matching worksheet
Set Tws = .Sheets(i)
Set tbl = Ws.ListObjects(1)
With tbl ' Deleting data from current table in the worksheet
If Not .DataBodyRange Is Nothing Then
.Rows.Delete
End If
End With
fr = WorksheetFunction.Match("ConsistentKeyword", Ws.Columns(1), 0) - 3 ' First row
fc = 1 ' First column
lc = Tws.Cells(fr, fc).End(xlToRight).Column ' Last column
lr = Tws.Cells(fr, fc).End(xlDown).Row - 3 ' Last row
Set NewData = Tws.Range(Tws.Cells(fr, fc), Tws.Cells(lr, lc))
NewData.Copy
tbl.DataBodyRange.PasteSpecial xlPasteValues '<--- OBS ERROR IS IN THIS LINE
Application.CutCopyMode = False
End If
Next Ws
Next i
.Close SaveChanges:=False
End With
Application.DisplayAlerts = True
End Sub
请注意,我的错误发生在tbl.DataBodyRange.PasteSpecial xlPasteValues
编辑:我尝试添加代码:
Ws.Activate
tbl.Range(2, 1).Select
Selection.PasteSpecial xlpastevalues
代替 :
tbl.DataBodyRange(1, 1).PasteSpecial xlPasteValues
但这会产生运行时错误“1004”:为此,所有合并的单元格必须具有相同的大小。,但是我复制的所有单元格都没有被合并。由于这需要激活工作表和选择,我宁愿解决我的原始代码。
解决方案
我通过.ListRows.Add
在with tbl
子句中添加该行并设置(以保持源格式)使我的代码工作:
NewData.Copy
tbl.DataBodyRange(1, 1).PasteSpecial
感谢@SJR 的提示。
推荐阅读
- asp.net-core - NonFactors.Grid.Mvc6 点击不触发
- android - 无法为 Google Drive 创建令牌目录
- python - Run python script on Windows 10
- c# - 从另一个类添加 XAML 元素
- vue.js - 我已经为使用 Yarn 模块依赖项运行 Vue.js 应用程序编写了 dockerfile,但在机器上运行
- r - 为什么会出现词法错误:当通过 curl 发送 json_string 时,json 文本中的字符无效,但在 R 控制台中却没有?
- python - 为什么 .keys() 在 dict 对象之后,而“排序”在之前?dictionary.keys() 排序(字典)
- java - 如何使用 Telegram Bot API 提高发送图像的质量
- php - 无法将我的 $_GET 变量放入 SQL 语句中
- python - 用 sympy 求解非线性方程,但我得到的结果虚部很小