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)

 

[Alex Blakenburg]

I am sure @shina67 will be pleased to hear that their efforts have paid off.

 

[Keebler]

it filtered the data in all three columns QUICKLY!!!!!!!

how hard would it be to add a sort element? but before that, it would need to not copy the top row (does the top row need to be deleted prior to running the filter VBA?)
but it would need to be same but separate for each column

column A, Q, and AG

 

[Keebler]

I am sure @shina67 will be pleased to hear that their efforts have paid off.

AGREED
they spent a long time with this and i greatly appreciate it
the system does not allow me to select more than one working solution.. which is understandable but not desirable in this case

 

[Keebler]

what i did was mark Shiva67 post 38 as the solution, but liked your swap, because that is what really helped
thank you both!!!!!!!!!!

should i open a new thread to continue this?
adding a sort to the filter or continue here?

also, modifying the range to exclude the top row and place the filtered data on row 3 of INDEX2
nevermind i see how to change the filtered range
Set sourceRange = sourceWS.Range("A1:aq" & lastRow)

to
Set sourceRange = sourceWS.Range("A3:aq" & lastRow)

and changing the destination

from
destinationRange.Copy destinationWS.Range("A1")

to

destinationRange.Copy destinationWS.Range("A3")

 

[Alex Blakenburg]

I'm in Australia and about to log off for the night.
Give shina a chance to respond to your sort request but it might be worth calling it a day on this thread.
Adding a sort is not a big deal, you just need to be specific on what columns make up the data set (first and last column) and which of those column determine the sort order and whether there are headings and on what row.
XL2BB show us what the columns are, what the data types are and save us having to manually create test data.

 

[Keebler]

alex b
thank you
g'day to you

 

[Keebler]

so simply adding this to the end of the vba moved everything down to where i wanted it

destinationWS.Range("a2").EntireRow.Insert

Sub copyto_test_REMOVEBLANKS_b18() 'worked (by Shina67)

    Dim sourceWS As Worksheet
    Dim destinationWS As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim lastRow As Long
    Dim i As Long, J As Long
    Dim destinationLastRow As Long
    Dim emptyRow As Boolean
   
    Set sourceWS = ThisWorkbook.Sheets("INDEX")
    Set destinationWS = ThisWorkbook.Sheets("INDEX2")
   
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).row
   
     Set sourceRange = sourceWS.Range("A3:aq" & lastRow)
   
    destinationWS.Cells.Clear

    For i = 1 To sourceRange.Rows.Count
        emptyRow = True
        For J = 1 To sourceRange.Columns.Count
            If sourceRange.Cells(i, J).Value <> "" Then 'Alex B
                emptyRow = False
                Exit For
            End If
        Next J
        If Not emptyRow 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("A3")
        End If
    End If
destinationWS.Range("a2").EntireRow.Insert

End Sub

 

[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]

Thank you Shina67 - your help has been much appreciated and VERY VERY educational -you have no idea how grateful I am

//SOLVED
//CLOSED