VBA-如果单元格不为空，则复制范围

Question

I currently have this code:

Sub createSheets(range_Copy As Range, range_Paste As Range)
    'Copy the data
    range_Copy.Copy

    'Paste the data into the new worksheet
    With range_Paste
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
End Sub

...and this...

Call createSheets(Sheets("Export from QB - Annual Sales").Range("E:T"), Sheets("Sales - " & Sales_Date_Annual).Range("A1"))

It works great but what I actually want to do is... when copying the range E:T, I only want to copy the rows that do not have a blank value in column E... regardless if there is anything in the other columns.

Answer 1

I think below code will help you. Useful information here is, that you can reference a cell in a range using relative reference, ie Range("D4:E6").Cells(1, 1) is reference to cell D4 . This way you can easily loop through given range.

Sub LoppthroughRange()
Dim i As Long, j As Long, rng As Range
Set rng = Range("E:T")
For i = 1 To rng.Rows.Count
    If Not IsEmpty(rng.Cells(i, 1)) Then
        For j = 1 To rng.Columns.Count
            'copy all cells in a row
        Next
    End If
Next

End Sub

Putting it all together, you should use:

Sub createSheets(range_Copy As Range, range_Paste As Range)
    Dim i As Long, j As Long, k As Long
    k = 1

    For i = 1 To range_Copy.Rows.Count
        If Not IsEmpty(range_Copy.Cells(i, 1)) Then
            With range_Copy
                .Range(Cells(i, 1), Cells(i, .Columns.Count)).Copy
            End With
            With range_Paste
                .Range(Cells(k, 1), Cells(k, .Columns.Count)).PasteSpecial xlValues
                .Range(Cells(k, 1), Cells(k, .Columns.Count)).PasteSpecial xlFormats
            End With
            k = k + 1
        End If
    Next
End Sub