既存のテーブルに隣接する列で機能するマクロを作成しようとしています。このマクロの目的は、テーブルに存在するセル結合を取得し、それらを次の 2 つの列にコピーすることです (これは、より大きな目的を持つもののヘルパー メソッドです)。私のコードは以下のとおりですが、次の行で発生する「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
また、これをよりエレガントな方法でコーディングする方法について何か提案があれば、大歓迎です。書式設定をコピーしてから境界線と塗りつぶしを削除すると、コードがかさばるように見えます。ありがとう。