Maintain Row Integrity in Pasting of Non-Blank Rows

Question

This is a difficult Visual Basic question so I’m not sure if anybody in this forum will be able help. But it’s worth a try.

I wrote a program in Visual Basic to be used as a macro in Excel.

In the macro, I am taking data in sheet1 (FINAL) and copying & pasting the values into sheet2 (Data). My data range in sheet1 has many blank cells so I wanted to create a program that will only paste rows with values (versus rows with only blank cells).

My program right now modifies my data range in sheet 1 before pasting into sheet2 and I don’t want that……..my formatting gets all screwed up as a result too. Instead I want the data in my sheet1 to stay completely the same and the blank rows to be removed in the paste action going into sheet2.

My data in sheet1 begins at Column AL and proceeds to Column CD.

It’s very important that the integrity of the rows be maintained. I don’t want blank cells to be erased during the paste, but rather BLANK ROWS from the range to be erased during the paste. So if there is a row between columns AL and CD that has even just one data point, the row as a whole must be maintained in the paste. But for any rows between columns AL and CD that are completely blank, they need to be removed in the paste action going into sheet2.

My existing program is below. Any help would be greatly appreciated.

Dim ws As Worksheet

Set ws1 = Worksheets("FINAL")
Set ws2 = Worksheets("Data")

With ws1.UsedRange
lastcolumn = .Cells(1, 1).Column + .Columns.Count - 1
lastrow = .Cells(1, 1).Row + .Rows.Count - 1
End With

ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).AutoFilter field:=1, Criteria1:="<>"
ws1.Range(Cells(1, 38), Cells(lastrow, lastcolumn)).Copy

ws2.Range("A1").PasteSpecial xlPasteValues

Application.CutCopyMode = False

Answer 1

This is a difficult Visual Basic question so I’m not sure if anybody in this forum will be able help. But it’s worth a try.

Hope it was worth a try :P

Is this what you are trying?

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim rng As Range, CellsTobeCopied As Range, aCell As Range

    '~~> Sheet which has range that you want to copy
    Set wsInput = ThisWorkbook.Sheets("Sheet1")

    '~~> Set range that you would like to copy
    Set rng = wsInput.Range("A1:E4")

    '~~> Output Sheet where you want to paste
    Set wsOutput = ThisWorkbook.Sheets("Sheet2")

    For Each aCell In rng.Rows
        '~~> Check if the entire row is blank
        If Application.WorksheetFunction.CountA(aCell) <> 0 Then
            '~~> Construct your range to be copied
            If CellsTobeCopied Is Nothing Then
                Set CellsTobeCopied = aCell
            Else
                Set CellsTobeCopied = Union(CellsTobeCopied, aCell)
            End If
        End If
    Next

    '~~> Copy final range
    If Not CellsTobeCopied Is Nothing Then
        CellsTobeCopied.Copy
        '~~> In case you want to preserve formats
        wsOutput.Range("A1").PasteSpecial xlPasteAll

        '~~> If you wan tto paste values then comment the above and use this
        ' CellsTobeCopied.Copy wsOutput.Range("A1")
    End If
End Sub

Screenshot