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

luzmen · Jun 29th 2017

Hello,

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

Code

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

Display More

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.

**pike** · Jun 29th 2017

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

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

luzmen · Jun 30th 2017

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...

**KjBox** · Jun 30th 2017

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

Please attach your workbook.
[sw]*[/sw]

luzmen · Jun 30th 2017

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

KjBox,

Herewith attached the workbook.

**KjBox** · Jun 30th 2017

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

Yes, those formulas were the cause of the issue. Try this:

Code

Sub CopyRange()
Dim x, y(), i As Long, ii As Long
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

luzmen · Jun 30th 2017

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

Code

.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.

**KjBox** · Jun 30th 2017

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

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

luzmen · Jun 30th 2017

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!!!

**KjBox** · Jun 30th 2017

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

You're welcome.

**pike** · Jun 30th 2017

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

my loop less alternative

Code

Option Explicit
Sub Test()
With Sheets("Data").Range("A104:F110")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>"
.Offset(1, 0).Copy
End With
With Sheets("Report")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Data").Range("A104:F110")
.AutoFilter
End With
End Sub

Display More

Xbridge · Apr 14th 2018

This is my first post so “Hi to everyone” I am also quite new to VBA , I have read the thread here and using Kjbox code above it works fine, in my scenario my source data is in workeet2 column Z, the column contains an extracted list of data of undefined length up to 100 entries and contains cells with data and blanks). I want to copy non blank cells over to worksheet 1 with the 1st entry copied starting in B3. What I’m not sure is how to define the row, column in the worksheet? Appreciate if someone could guide me Kind regards Phil

**AlanSidman** · Apr 14th 2018

Unfortunately your post does not comply with our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.

Share