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]

A constant is a named value that remains unchanged during the execution the code.

so, when does it need it need to be declared? or does it?

 

[Keebler]

Let's go back to post #5 where the code filtered and not deleted. An adjustment of that code should delete the rows. The code seemed to work fine for filtering so the small adjustment for deleting should work.

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.Cells(tws.Rows.Count, "E").End(xlUp).Row

    If lrow <= 3 Then
        trng = tws.Range("A3").Address
    Else
        trng = tws.Cells(lrow + 1, 1).Address
    End If

    crow = aws.Cells(aws.Rows.Count, "E").End(xlUp).Row
    srow = aws.Cells(aws.Rows.Count, "H").End(xlUp).Row

    srng = "K" & srow & ":AQ" & crow
    slist = "K" & srow & ":AQ" & crow

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

    aws.Range("K" & srow & ":AQ" & crow).EntireRow.Delete

    tws.AutoFilterMode = False
   
Application.CutCopyMode = False
End Sub

these lines are not the way I had them when the vba code worked
srng = "K" & srow & ":AQ" & crow
slist = "K" & srow & ":AQ" & crow

they should be:
srng = "aq" & crow
slist = ("k" & srow & ":" & srng)

 

[shina67]

You can replace the line

aws.Range("K" & srow & ":AQ" & crow).EntireRow.Delete

with

Dim srcRange As Range
Set srcRange = aws.Range("K" & srow & ":AQ" & crow)
srcRange.EntireRow.Delete

 

[Keebler]

You can replace the line

aws.Range("K" & srow & ":AQ" & crow).EntireRow.Delete

with

Dim srcRange As Range
Set srcRange = aws.Range("K" & srow & ":AQ" & crow)
srcRange.EntireRow.Delete

so, what am i still missing?

these lines
Set srcRange = aws.Range("K" & srow & ":AQ" & crow)
srcRange.EntireRow.Delete

it will still want to delete rows from the source page(s)

the rows i want deleted are on the target page (INDEX), nothing deleted from the source page(s)

 

[shina67]

so, what am i still missing?

these lines
Set srcRange = aws.Range("K" & srow & ":AQ" & crow)
srcRange.EntireRow.Delete

it will still want to delete rows from the source page(s)

the rows i want deleted are on the target page (INDEX), nothing deleted from the source page(s)

Only empty rows

 

[Keebler]

Only empty rows

from the source page??
i do not want anything deleted from the source page

 

[Keebler]

the VBA code deleted the WHOLE sheet between the declared range

 

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

 

[Keebler]

Thank you

so i added the new page (INDEX2)
and ran the VBA unchanged

the result was a mirror of the source (INDEX) columns A through D
there was no removal of any blank or empty spaces

 

[shina67]

Apologies my mistake (blaming lack of sleep). The below code properly removes empty rows before pasting to the destination sheet.

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
    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("A1:D" & lastRow)
   
    destinationWS.Cells.Clear

    For i = 1 To sourceRange.Rows.Count
        emptyRow = True
        For j = 1 To sourceRange.Columns.Count
            If Not IsEmpty(sourceRange.Cells(i, j).Value) Then
                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("A1")
        End If
    End If
End Sub