Excel VBA插入复制的单元格语法

我的macros的目标是太简单地复制其中值为1的任何行的单元格，并将相同的值插入右上方的另一行。 唯一的警告是我也有列B＆C中的值，所以我希望那些复制和插入。 我的macros在下面

我已经认识到，问题是擅长采取列AR而不是范围AR，但我有点麻烦绕过这一点，因为我不能想到命名我的Rvariables绕过这个问题的另一种方式。

谢谢你的帮助！

Sub BlankLine() Dim Col As Variant Dim BlankRows As Long Dim LastRow As Long Dim R As Long Dim StartRow As Long Col = "A" StartRow = 1 BlankRows = 1 LastRow = Cells(Rows.Count, Col).End(xlUp).Row Application.ScreenUpdating = False With ActiveSheet For R = LastRow To StartRow + 1 Step -1 If .Cells(R, Col) = "1" Then .Range("AR:CR").Copy Selection.Insert Shift:=xlDown End If Next R End With Application.ScreenUpdating = True End Sub 

Answer 1

更新：我改变了代码只是复制这三列（A到C），然后插入一个新的行，然后将值设置为这三列。 注释在代码中。 如果要复制更多列，只需更改dupRangevariables中的整数（即.Cells(R, Col + 2)) ）

 Sub BlankLines() Dim Col As Integer Dim BlankRows As Long Dim LastRow As Long Dim R As Long Dim StartRow As Long Col = 1 'changed to number StartRow = 2 'changed to 2 since you have a header BlankRows = 1 'not used in this code... LastRow = Cells(Rows.Count, Col).End(xlUp).Row Application.ScreenUpdating = False With ActiveSheet For R = LastRow To StartRow Step -1 If .Cells(R, Col) = "1" Then Dim dupRange As Variant 'array to store values Set dupRange = .Range(.Cells(R, Col), .Cells(R, Col + 2)) 'store the column values for the row .Rows(R & ":" & R).Insert Shift:=xlDown 'insert the new row c = 0 'to increment over the copied columns For Each v In dupRange .Cells(R, Col + c) = v 'sets the array values to each column c = c + 1 Next v End If Next R End With Application.ScreenUpdating = True End Sub 

试试这个。 不是100％确定，如果这是你所追求的。