Question

在工作表A中，我有一列仪表读数，其静态命名范围为“MeterData”。范围的第一行是读取仪表时的日期（mm / dd / yy）。其余行包含仪表读数。

在该范围之上，同一列是月份，1月到12月，我从下拉列表中选择。

在工作表B中，我有12列，分别是1月到12月的标题。例如，如果在工作表A中选择的月份是2月，那么我希望复制命名范围，然后粘贴到工作表B中的2月标题下。工作表B中的第一个标题（1月）位于单元格G4中。

有充分理由说明仪表读数未直接输入工作表B中。

非常感谢任何有关VBA的帮助。我是一个真正的新手，我正在慢慢学习复制和调整短VBA解决方案，但实际上并不了解更多。感谢您的时间和知识。

Answer 1

试试这个。我已经对代码进行了评论，以解释它正在做什么，以便您可以更好地根据您的要求进行定制。

'Examine cell above 'MeterData' range - store in mth
mth = Range("MeterData").Offset(-1, 0).Cells(1, 1).Text

'Set destination column to 20 as default
paste_column = 20
'Skip on error as Match might not find the month(?) so will remain at 20
On Error Resume Next
'Re-set destination to column using Match to find occurence of 'mth' on row 4
paste_column = WorksheetFunction.Match(mth, Sheets("WorksheetB").Range("4:4"), 0)

Remove error skipping
On error goto 0

'Copy 'MeterData' range and Paste to WorksheetB, row 5, column found above.
Range("MeterData").Copy Destination:=Sheets("WorksheetB").Cells(5, paste_column)

编辑：现在使用复制/粘贴特殊值

'Examine cell above 'MeterData' range - store in mth
mth = Range("MeterData").Offset(-1, 0).Cells(1, 1).Text

'Set destination column to 20 as default
paste_column = 20
'Skip on error as Match might not find the month(?) so will remain at 20
On Error Resume Next
'Re-set destination to column using Match to find occurence of 'mth' on row 4
paste_column = WorksheetFunction.Match(mth, Sheets("WorksheetB").Range("4:4"), 0)

'Remove error skipping
On Error GoTo 0

'Copy 'MeterData' range into buffer
Range("MeterData").Copy

'Paste to WorksheetB, row 5, column found above.
Sheets("WorksheetB").Cells(5, paste_column).PasteSpecial Paste:=xlPasteValues

'Remove highlighter identifying copied area
Application.CutCopyMode = False

复制静态命名范围并将其粘贴到另一个工作表中的可变单元格地址

1 个答案: