Hi Everyone,
I am trying to copy and paste non-blank rows. I have tried two sets of code found on another thread but both have issues I am too ignorant to resolve on my own.
This one works pretty well but I have some hidden rows that it causes to unhide. Also if the columns in the range that is being copied from are hidden, it copies all the blank rows.
Code
Sub PopulatePartsList()
Application.ScreenUpdating = False
With Sheets("Incoming").Range("V40:AF417")
.AutoFilter
.AutoFilter Field:=4, Criteria1:="<>" 'if Description (4th column) is blank, dont copy
.Offset(0, 0).Copy 'copy starting at the top left cell of the range V40:AF417
End With
With Sheets("Incoming")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'paste values 1 row and 2 columns over from the last last non-blank cell
End With
With Sheets("Incoming").Range("V40:AF417")
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
Display More
This one I am way to dense to really understand but it is only copying the first row. This code works a lot faster and doesn't have the other drawbacks I mentioned for the first set of code, so it would be nice if it could be made to work.
Code
Sub CopyRangeOzgEdit25() ' only copies first row
Dim x, y(), i As Long, ii As Long
x = Sheets("Incoming").[V40:AF417]
For i = 1 To UBound(x, 1)
If x(i, 1) <> "" Then
ReDim Preserve y(1 To 6, 1 To i)
For ii = 1 To 6
y(ii, i) = x(i, ii)
Next
Else: Exit For
End If
Next
With Sheets("Incoming")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 2).Resize(UBound(y, 2), 6) = Application.Transpose(y)
End With
End Sub
Display More
This is the sheet I am working with:
Thanks in advance for any help!