我正在尝试编写一个宏,该宏从一个工作簿读取列标题,在另一个工作簿中查找匹配的列标题,然后粘贴这些值。列标题分别位于源工作簿的第1行和目标工作簿的第5行。最后,我还希望在两个工作簿的多个选项卡之间循环,并执行相同的操作,但要循序渐进。
Sub EquipmentTransfer()
Dim sourceWB As Workbook, targetWB As Workbook
Dim sourceWS As Worksheet, targetWS As Worksheet
Dim sourceColumn As Range, targetColumn As Range
' Set sourceWB and targetWB to the workbooks you want to copy from and paste to
Set sourceWB = Workbooks("Memorial Hospital of South Bend Equipment List v0.2.xlsx")
Set targetWB = Workbooks("Memorial Hospital Energy Model v0.1.xlsm")
' Set sourceWS and targetWS to the worksheets you want to copy from and paste to
Set sourceWS = sourceWB.Sheets("Chillers")
Set targetWS = targetWB.Sheets("16 - Electric Chillers")
' Loop through each column in the source worksheet
For Each sourceColumn In sourceWS.Columns
' Check if the column header (in cell A1) exists in row 5 of the target worksheet
On Error Resume Next
If Not IsError(Application.Match(sourceColumn.Cells(1, 1).Value, targetWS.Rows(5), 0)) Then
On Error GoTo 0
' If it exists, set targetColumn to the matching column in the target worksheet
Set targetColumn = targetWS.Columns(Application.Match(sourceColumn.Cells(1, 1).Value, targetWS.Rows(5), 0))
' Copy the data from the source column, skipping the header row, and paste it into the target column, also skipping the first 4 rows
sourceColumn.Offset(1, 0).Resize(sourceColumn.Rows.Count - 1, 1).Copy
targetColumn.Offset(5, 0).PasteSpecial xlPasteValues
End If
Next sourceColumn
End Sub
当前宏在第27行抛出了一个对象定义的错误,我还没能找出原因。
我已经删除了第27行的调整大小部分,但它抛出了相同的错误
1条答案
按热度按时间moiiocjp1#
尝试这样的东西-我已经抽出复制部分到一个单独的子,所以它更可重用。