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.
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
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.
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
This is the sheet I am working with:
Thanks in advance for any help!