我正在尝试创建一个适用于与现有表相邻的列的宏。此宏的目的是获取表格中存在的任何单元格合并并将它们复制到接下来的两列中(这是用于更大目的的辅助方法)。我的代码在下面,但我收到一条错误消息,上面写着“Range 类的PasteSpecial 方法失败”,该错误发生在以下行:
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
正上方的行是一个测试行,用于检查代码是否在循环的第一次迭代中工作,确实如此。但是,一旦代码尝试重新迭代并再次粘贴,代码就会失败。我相信这是因为“Selection.PasteSpecial”调用不再引用正确的对象,但我不确定如何修复它。
Sub extendColumnMerges()
'
' Works on a column adjacent to a table by extending the column's merge-formatting to the selected column
' Active cell must begin as the first cell in the column immediatley adjacent the table on the right
'
Dim cols As Integer
cols = 2
'Selects the last column of the table and copies the selection into the new column, modifying the format of the new column
Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown)).Select
Selection.Copy
'Pastes the columns' merge-formatting into each specified column adjacent the table on the right
For c = 1 To cols
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "Yes"
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Removes the formatting from the cells in the new column
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Removes borders from the newly modified column
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.Select
Next c
End Sub
此外,如果有任何关于如何以更优雅的方式编码的建议,他们将不胜感激。复制格式然后删除边框和填充在代码中似乎很庞大。谢谢。