Excel VBA插入複製的單元格語法

Question

我的宏的目標太簡單，只複製其中包含值1的任何行的單元格，並將相同的值插入右上方的另一行中。唯一需要注意的是我在列B & C中也有值，所以我希望複製和插入這些值。我的宏是低於

我已經認識到，問題是優秀的是採取列AR相對於範圍AR，但我有點麻煩繞過這一點，因爲我不能想到命名我的R變量另一種方式繞過這個問題。

非常感謝您的幫助！

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），然後插入新行，然後設置的值，以這三個列。評論在代碼中。如果要複製多個列，只是改變了整在dupRange變量（即，在.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％確定這是否是你想要的。