简体   繁体   中英

Excel VBA Insert copied cells syntax

The goal of my macro is too simply copy the cells of any row that has the value 1 in it and insert that same value into another row right above it. The only caveat is I also have values in columns B & C so I want those copied and inserted as well. My macro is below

I have recognized that the problem is excel is taking Columns AR as opposed to the range AR but I'm having a bit of trouble getting around this as I cant think of naming my R variable another way to bypass the problem.

Thanks a ton for the help!

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

Updated: I changed the code to just copy those three columns (A to C) then insert a new row then set the values to those three columns. Comments are in the code. If you want to copy more columns, just change the integer in the dupRange variable (ie, the 2 in .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

Give this a try. Not 100% sure if this is what you're after.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM