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)

 

[Keebler]

is there a way to filter out the blank or empty rows?
is what you asked for in post #4.
that's what the additional code does.

that is correct,
can you tell me why it minimized the "blank" rows?
perhaps I simply do not understand the vba

 

[shina67]

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

The filter is applied to Column A and filters out and blanks

 

[Keebler]

so that is the desired effect?
to minimize the empty rows?

i really would have preferred it to delete the empty rows over minimizing them... (sorry, i did not know that would have been an issue)

 

[shina67]

.  
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 in the target worksheet
    Set rng = tws.Range("A3:A" & lrow)
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    tws.AutoFilterMode = False
  
    
    Application.CutCopyMode = False

End Sub

The code has been amended to the following:- ' Filter out blank or empty rows in the target worksheet
Set rng = tws.Range("A3:A" & lrow)
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

This should now delete the rows instead of filtering them as per your original request.

 

[Keebler]

so, i got the row delete to work with this

Sub delblnkrows_test4() 'worked
Dim ws As Worksheet
Dim rng As Range

Set ws = Sheets("INDEX")
Set rng = ws.Range("a3:a20")

rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

 

[Keebler]

this still does not work when the sheet is populated with even the simplest of data (involving 3 columns "a" "q" and "aa")
I keep getting an error that no cells where found when I can clearly see at least 12 (just on the viewable sheet)

Sub delblnkrows_test4() 'worked
Dim tws As Worksheet
Dim lrow As Long, i As Long
Dim rng As Range

Set tws = Sheets("INDEX")
'lrow = tws.Range("e1") 'gets the last row of destination ws
Set rng = tws.Range("a3:a91")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

so what am i missing?

 

[shina67]

this still does not work when the sheet is populated with even the simplest of data (involving 3 columns "a" "q" and "aa")
I keep getting an error that no cells where found when I can clearly see at least 12 (just on the viewable sheet)

Did you try the new code I put on post #14. You had said it worked before but needed the filter removing and delete empty rows instead. The above code in post #14 does that b

 

[Keebler]

Did you try the new code I put on post #14. You had said it worked before but needed the filter removing and delete empty rows instead. The above code in post #14 does that b

MY BAD!!!
I failed to see your new post when I posted the 2 follow up posts.

I will run the revision and report back... (which ironically is quite similar to what you posted) (I see that you have added the clipboard clean, and the autofiltering turned off)

Sub delblnkrows_test5() 'failed
Dim tws As Worksheet
Dim lrow As Long, i As Long
Dim rng As Range

Set tws = Sheets("INDEX")
'Set rng = ws.Range("a3:a20")
lrow = tws.Range("a" & tws.Rows.Count).End(xlUp).row
  

 ' Filter out blank or empty rows in the target worksheet
    Set rng = tws.Range("A3:A" & lrow)
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    tws.AutoFilterMode = False
 
  
    Application.CutCopyMode = False

End Sub

result
same error

run time error '1004':
No cells were found

I can clearly see multiple empty rows

FLAC MASTERS 3 1 555b307.xlsm
	A
18	ABBA - I HAVE A DREAM - 100% ABBA {DISC 1} 2019 - 19 - FMA0101 [ALBUMS]
19	ABBA - OUR LAST SUMMER - 100% ABBA {DISC 1} 2019 - 23 - FMA0101 [ALBUMS]
20	ABBA - THE DAY BEFORE YOU CAME - 100% ABBA {DISC 1} 2019 - 24 - FMA0101 [ALBUMS]
21	ABBA - ANGEL EYES - 100% ABBA {DISC 1} 2019 - 25 - FMA0101 [ALBUMS]
22
23
24	ABBA - SUMMER NIGHT CITY - 100% ABBA {DISC 2} 2019 - 01 - FMA0101 [ALBUMS]
25	ABBA - HEAD OVER HEELS - 100% ABBA {DISC 2} 2019 - 02 - FMA0101 [ALBUMS]
26	ABBA - EAGLE (SHORT VERSION) - 100% ABBA {DISC 2} 2019 - 03 - FMA0101 [ALBUMS]
27	ABBA - THE VISITORS - 100% ABBA {DISC 2} 2019 - 04 - FMA0101 [ALBUMS]
INDEX

FLAC MASTERS 3 1 555b307.xlsm
	A
50	ABBA - BUMBLEBEE - VOYAGE 2021 - 08 - FMA0101 [ALBUMS]
51	ABBA - ODE TO FREEDOM - VOYAGE 2021 - 10 - FMA0101 [ALBUMS]
52
53
54
55
56	ACE OF BASE - WONDERFUL LIFE - DA CAPO [JAPAN PROMO] 2003 - 07 - FMA0101 [ALBUMS]
57
58
59	ACE OF BASE - TRAVEL TO ROMANTIS - FLOWERS 1998 - 04 - FMA0101 [ALBUMS]
60	ACE OF BASE - DONNIE - FLOWERS 1998 - 13 - FMA0101 [ALBUMS]
61	ACE OF BASE - CRUEL SUMMER {BONUS MIX} - FLOWERS 1998 - 14 - FMA0101 [ALBUMS]
62
63
64	ACE OF BASE - EVERYTIME IT RAINS - GREATEST HITS 2000 - 03 - FMA0101 [ALBUMS]
65	ACE OF BASE - BEAUTIFUL LIFE {JUNIOR VASQUEZ MIX} - GREATEST HITS 2000 - 12 - FMA0101 [ALBUMS]
66
67
68	ACE OF BASE - CRUEL SUMMER {BONUS MIX} - GREATEST HITS 2008 - 12 - FMA0101 [ALBUMS]
69
70
71	ACE OF BASE - EVERYTIME IT RAINS - PLAYLIST THE VERY BEST OF ACE OF BASE 2011 - 09 - FMA0101 [ALBUMS]
72	ACE OF BASE - ALWAYS HAVE, ALWAYS WILL - PLAYLIST THE VERY BEST OF ACE OF BASE 2011 - 12 - FMA0101 [ALBUMS]
73
74
75	ACE OF BASE - LOVE IN DECEMBER - SINGLES OF THE 90S 1999 - 06 - FMA0101 [ALBUMS]
76	ACE OF BASE - CRUEL SUMMER - SINGLES OF THE 90S 1999 - 11 - FMA0101 [ALBUMS]
77	ACE OF BASE - NEVER GONNA SAY I'M SORRY - SINGLES OF THE 90S 1999 - 14 - FMA0101 [ALBUMS]
78
79
80	ACE OF BASE - RAVINE - THE BRIDGE [JAPAN EDITION] 1995 - 06 - FMA0101 [ALBUMS]
81	ACE OF BASE - WHISPERS IN BLINDNESS - THE BRIDGE [JAPAN EDITION] 1995 - 09 - FMA0101 [ALBUMS]
82	ACE OF BASE - YOU AND I - THE BRIDGE [JAPAN EDITION] 1995 - 11 - FMA0101 [ALBUMS]
INDEX

 

[Keebler]

what i can not understand is why this works

Sub delblnkrows_test4() 'worked
Dim ws As Worksheet
Dim lrow As Long
Dim rng As Range

Set ws = Sheets("INDEX")
Set rng = ws.Range("a3:a20")

'rng.SpecialCells(xlCellTypeBlanks).EntireRow.Select
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

FLAC MASTERS 3 1 555b307.xlsm
	A
3	test
4	test
5
6
7	test
8	test
9	test
10	test
11
12	test
13	test
14
15
16
17
18	test
19	test
INDEX

FLAC MASTERS 3 1 555b307.xlsm
	A
3	test
4	test
5	test
6	test
7	test
8	test
9	test
10	test
11	test
12	test
13
14
15
16
17
18
19
INDEX

 

[Keebler]

what am i missing?