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.