Copy Non-Blank rows in a Range and Paste to Other Sheets

Hello,

I have this code that copy range and paste to other sheets:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet




    Set copySheet = Worksheets("Data")
    Set pasteSheet = Worksheets("Report")




    copySheet.Range("A105:F110").Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

However, when the copy range has only values in range A105:F105 and range below are blanks, it copies all range to worksheet("Report"). And when i add another data, it started in the row where the upper row is empty.

What is the missing code that only copy range with values and paste it to worksheet("Report")? So that when i add another data, it will paste next to it...

Thanks.

Re: Copy Non-Blank rows in a Range and Paste to Other Sheets

Quote from pike;794903

Hi luzmen
something like,,,,

Code

Set copySheet = Worksheets("Data") 
    Set pasteSheet = Worksheets("Report") 
dim lngRow as long
lngRow=copySheet.Cells(Rows.Count, 1).End(xlUp).Row
copySheet.Range("A105:F"&lngRow).Copy

pike,

Thank you so much for the reply.. but the code still didn't work, it copies the blank rows that included in the Range A105:F110.

By the way, range A105:F110 has a formula function on every cell, the function looks like this: =if(cellvalue="","",cellvalue).
Im so sorry i forgot to tell, maybe this is the reason why the blank rows were always included...

Re: Copy Non-Blank rows in a Range and Paste to Other Sheets

KjBox,

Herewith attached the workbook.

Re: Copy Non-Blank rows in a Range and Paste to Other Sheets

Thanks KJBox, It Works!

But i've noticed something, when there is no data in the range, there is a Run time Error at this portion

.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 6) = Application.Transpose(y)

There is a possibility that no data for Spouse Business/Work Information.

Re: Copy Non-Blank rows in a Range and Paste to Other Sheets

Quote from KjBox;794981

This has a code line to check that there is data to copy.

Code

Sub CopyRange()
    Dim x, y(), i As Long, ii As Long
     
    If Sheets("Data").[a105] = "" Then Exit Sub
    x = Sheets("Data").[a105:f110]
    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("Report")
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 6) = Application.Transpose(y)
    End With
     
End Sub

Display More

Thank you so much!! Works Perfectly!!!