new project: copy range without empty or blank rows

[Keebler]

I am currently working on a project to copy a range from one worksheet to another removing empty or blank cells (rows) and pasting them into another ws at the bottom of the page.

Sub copyto_test()
'define variables
Dim lrow As Long, srow As Long, erow As Long, crow As Long
Dim slist As String, srng As String, trng As String
Dim aws As Worksheet, sws As Worksheet, tws As Worksheet
Dim crg As Range

'set constants
Set aws = activesheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1") 'gets the last row of destination ws
If lrow <= 3 Then 'checks to make sure row is at least row 3
trng = tws.Range("a3").Address
Else
trng = tws.Range("a" & (lrow + 1))
End If
crow = aws.Range("e1") 'gets the last row of the current sheet
srow = aws.Range("h1") 'gets the first row of the current sheet
srng = Range("aa" & crow)
slist = ("k" & srow & ":" & srng)


Range(slist).Copy Range(trng).PasteSpecial(xlPasteValues)




End Sub

so the problem is the last line.

Range(slist).Copy Range(trng).PasteSpecial(xlPasteValues)

unable to get the pastespecial property of the range class

im sure it is something stupid im missing...

no other errors are showing up --- at this time (and no i havent tried the removal of the blank rows yet)

 

[shina67]

I have re-read all the previous posts and originally you want the empty rows filtering out. Then later on you wanted them deleting. So I understand to make it clear what you want is :-

To copy worksheet (INDEX) to another worksheet (I have called it INDEX2) removing all empty or blank rows and pasting all rows with data in them in the next available empty row in INDEX2?

To do the above below is the code:-

Sub CopyAndRemoveEmptyRows()
    Dim sourceWS As Worksheet
    Dim destinationWS As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim lastRow As Long
    Dim i As Long
    Dim destinationLastRow As Long
    
    Set sourceWS = ThisWorkbook.Sheets("INDEX")
    Set destinationWS = ThisWorkbook.Sheets("INDEX2")
    
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
    
[B]' Set the source range (adjust range as needed)[/B]
    Set sourceRange = sourceWS.Range("A1:D" & lastRow)
    
    destinationWS.Cells.Clear
    
    For i = 1 To sourceRange.Rows.Count
        If Application.WorksheetFunction.CountA(sourceRange.Rows(i)) > 0 Then
            If Not destinationRange Is Nothing Then
                Set destinationRange = Union(destinationRange, sourceRange.Rows(i))
            Else
                Set destinationRange = sourceRange.Rows(i)
            End If
        End If
    Next i
   
    destinationLastRow = destinationWS.Cells(destinationWS.Rows.Count, "A").End(xlUp).Row
    
    If Not destinationRange Is Nothing Then
        If destinationLastRow > 0 Then
            destinationRange.Copy destinationWS.Cells(destinationLastRow + 1, "A")
        Else
            destinationRange.Copy destinationWS.Range("A1")
        End If
    End If
End Sub

This code will copy non-empty rows from the specified range in the "INDEX" worksheet to the "INDEX2" worksheet, removing any empty rows, and paste them into "INDEX2" in the next available empty row. Adjust the range ("A1:D" & lastRow) in the sourceRange assignment to match the range you want to copy from the "INDEX" worksheet.

 

[Alex Blakenburg]

Does it make any diffference if you swap out the first line for the second line below:

            'If Not IsEmpty(sourceRange.Cells(i, j).Value) Then
            If sourceRange.Cells(i, j).Value <> "" Then

 

[shina67]

Sorry I am late to the party. It's been an extremely long tiring week.
@Alex Blakenburg thanks for clarifying some issues
@Keebler glad you have the result you required.
Probably best closing this thread down now as it has 68 posts on it and starting a new thread with the new issue you are wanting help with.

 

[Keebler]

so changing the trng to long
did CHANGE the error
method 'range of object '_global' failed
trng is showing "0" now

i know im missing something

 

[shina67]

The error you're encountering is likely due to how you're assigning the destination range address to the `trng` variable. Here's a corrected version of your code:

Sub copyto_test()
' Define variables
Dim lrow As Long, srow As Long, erow As Long, crow As Long
Dim slist As String, srng As String, trng As String
Dim aws As Worksheet, sws As Worksheet, tws As Worksheet
Dim crg As Range

' Set constants
Set aws = ActiveSheet
Set tws = Sheets("INDEX")

lrow = tws.Range("E" & Rows.Count).End(xlUp).Row ' Get the last row of destination ws
If lrow <= 3 Then ' Check to make sure row is at least row 3
trng = tws.Range("A3").Address
Else
trng = tws.Cells(lrow + 1, 1).Address ' Get the first cell of the next available row
End If
crow = aws.Range("E" & Rows.Count).End(xlUp).Row ' Get the last row of the current sheet
srow = aws.Range("H" & Rows.Count).End(xlUp).Row ' Get the first row of the current sheet
srng = "AA" & crow
slist = "K" & srow & ":" & srng

aws.Range(slist).Copy ' Copy the range from the current sheet
tws.Range(trng).PasteSpecial xlPasteValues ' Paste the values to the destination worksheet

Application.CutCopyMode = False ' Clear the clipboard
End Sub

This revised code addresses several issues:

1. Corrected the way to find the last used row in a column by using `Rows.Count` and `End(xlUp)` method.
2. Changed how the destination range is assigned to ensure it's a valid cell address.
3. Removed unnecessary `PasteSpecial` method and directly pasted values using `PasteSpecial xlPasteValues`.
4. Added `Application.CutCopyMode = False` to clear the clipboard after pasting.

Please give this code a try and let me know if you encounter any further issues.

 

[Keebler]

Thank you Shina67,
I used your code as a reference and saw right away where I messed up. (there were several errors (as you said))

Sub copyto_test()
'define variables
Dim lrow As Long, srow As Long, crow As Long
Dim slist As String, srng As String, trng As String
Dim aws As Worksheet, tws As Worksheet

'set constants
Set aws = activesheet
Set tws = Sheets("INDEX")

lrow = tws.Range("e1") 'gets the last row of destination ws
If lrow <= 3 Then 'checks to make sure row is at least row 3
    trng = tws.Range("a3").Address
Else
    trng = tws.Cells(lrow + 1, 1).Address
End If

crow = aws.Range("e1") 'gets the last row of the current sheet
srow = aws.Range("h1") 'gets the first row of the current sheet
srng = "aq" & crow
slist = ("k" & srow & ":" & srng)

aws.Range(slist).Copy
tws.Range(trng).PasteSpecial (xlPasteValues)

you defiantly got me on the correct track

now, what I need to do (if possible) when the data is copied. is there a way to filter out the blank or empty rows?

 

[shina67]

Adjust the code as below to allow the filtering you are requiring:-

Sub copyto_test()
  
    Dim lrow As Long, srow As Long, crow As Long
    Dim slist As String, srng As String, trng As String
    Dim aws As Worksheet, tws As Worksheet
    Dim rng As Range
    
    
    Set aws = ActiveSheet
    Set tws = Sheets("INDEX")

    
    lrow = tws.Range("E" & tws.Rows.Count).End(xlUp).Row
    
    
    If lrow <= 3 Then
        trng = tws.Range("A3").Address
    Else
        trng = tws.Cells(lrow + 1, 1).Address
    End If

  
    crow = aws.Range("E" & aws.Rows.Count).End(xlUp).Row
    srow = aws.Range("H" & aws.Rows.Count).End(xlUp).Row
    
  
    srng = "K" & srow & ":AQ" & crow
    slist = "K" & srow & ":AQ" & crow

    
    aws.Range(slist).Copy
    tws.Range(trng).PasteSpecial (xlPasteValues)

    ' Filter out blank or empty rows
    Set rng = tws.Range("A3:A" & lrow)
    rng.AutoFilter Field:=1, Criteria1:="<>"

 
    Application.CutCopyMode = False
End Sub

This code should filter out any blank or empty rows in column A of ("INDEX") after copying the data.

 

[Keebler]

SO, thank you
but the vba code did NOT delete the empty rows, only minimized them..
AND
changing the columns row height is NOT correcting this

I ended up having to delete the entire column (a) and create a new column

 

[Keebler]

I am not sure WHY the vba did that
the new snip it simply defined the range (rng)
filtered the range
then cleared the clipboard

what am i missing?
there is no logical reason for the outcome

oh, and the rows numbering (furthest left) (-a)
went from black to blue

can you elaborate on the filter?
rng.AutoFilter Field:=1, Criteria1:="<>"

field1 (this is the column (of the defined range)- correct?)
critical1 (this defines what the "filter" does to column one (of the defined range) - correct?)
the "<>" means not equal to - correct? (here is where i get a bit confused.... isnt there supposed to be a greater than or less than " " (empty space)?