Runtime 1004 Copy Cells

[silentwolf]

Hi guys,
hope someone can look over my code and let me know what's wrong with this code.

Sub CopyNonBlankData()
    Dim wkbThis As Workbook
    Dim lngERow As Long
    Dim lngLRow As Long
    Dim i As Integer
    
    Set wkbThis = ActiveWorkbook
    
    lngLRow = tabWeeklyPlaner.Cells(Rows.Count, 1).End(xlUp).Row
    
    With ThisWorkbook
        For i = 3 To lngLRow
            If tabWeeklyPlaner.Cells(i, 1) <> "" Then
                tabWeeklyPlaner.Range(Cells(i, 1)).Copy
                tabWeeklyObjects.Activate
                lngERow = tabWeeklyObjects.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                ActiveSheet.Paste Destination:=tabWeeklyObjects.Range(Cells(lngERow, 1))
                tabWeeklyPlaner.Activate
            End If
        Next i
    End With
    Application.CutCopyMode = False
    
End Sub

The issue I am getting an Runtime Error on Line "tabWeeklyPlaner.range(Cells(i,1).copy"

tabWeeklyPlaner and tabWeeklyObjects are the Codenames of the Worksheets.

Also I as the tabWeeklyPlaner has in the range of Cells blanks and a Summery on the last used Cell.

I like to copy all not blank cells and without Summery into tabWeeklyObjects.

Can someone give me a hand on this please.

Thanks

Albert

 

[mohadin]

Another Bug

 ActiveSheet.Paste Destination:=tabWeeklyObjects.Range(Cells(lng[COLOR=#ff0000]L[/COLOR]Row, 1))

[COLOR=#333333]Sheets("tabWeeklyPlaner").....[/COLOR]

 

[jkpieterse]

SHouldn't that simply be:

tabWeeklyPlaner.Cells(i, 1).Copy

 

[silentwolf]

Hi guys,

Thanks for your reply!
jkpieterse yes you are right!

Sub CopyNonBlankData()
    Dim wkbThis As Workbook
    Dim lngERow As Long
    Dim lngLRow As Long
    Dim i As Integer
    
    Set wkbThis = ActiveWorkbook
    
    lngLRow = tabWeeklyPlaner.Cells(Rows.Count, 1).End(xlUp).Row
    
    With ThisWorkbook
        For i = 3 To lngLRow
            If tabWeeklyPlaner.Cells(i, 1) <> "" Then
                tabWeeklyPlaner.Cells(i, 1).Copy
                lngERow = tabWeeklyObjects.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                
                ActiveSheet.Paste Destination:=tabWeeklyObjects.Cells(lngERow, 1)
                
                tabWeeklyPlaner.Activate
            End If
        Next i
    End With
    Application.CutCopyMode = False
    
End Sub

I also don't need to activate line either.. however there is still the problem with the "Summery"

            If tabWeeklyPlaner.Cells(i, 1) <> "" OR "Summery" Then

does someone know how to chang that line?

Cheers..

 

[MARK858]

Maybe...

If tabWeeklyPlaner.Cells(i, 1) <> "" Or tabWeeklyPlaner.Cells(i, 1) <>"Summery" Then

Also make sure "Summery" shouldn't be spelt "Summary"

 

[silentwolf]

Hi Mark858,

unfortunatelly not

Well if I can not get it to work I am just delete the "Summary" oh just see it I did spell it wrong in my thread "Summery" should be "Summary" oops...

But you get what I mean at leas ,)

 

[silentwolf]

Hi Mark,

Yes I did see my mistake with spelling

Here is now my modified code..

It works .-)

Sub CopyNonBlankData()
    Dim wkbThis As Workbook
    Dim lngERow As Long
    Dim lngLRow As Long
    Dim i As Integer
    
    Set wkbThis = ActiveWorkbook
    
    Application.ScreenUpdating = False
    
    lngLRow = tabWeeklyPlaner.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    With ThisWorkbook
        For i = 3 To lngLRow
            If tabWeeklyPlaner.Cells(i, 1) <> "" And tabWeeklyPlaner.Cells(i, 1) <> "Ergebnis" Then
                tabWeeklyPlaner.Cells(i, 1).Copy
                lngERow = tabWeeklyObjects.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                
                ActiveSheet.Paste Destination:=tabWeeklyObjects.Cells(lngERow, 1)
            End If
        Next i
    End With
    Application.CutCopyMode = False
    tabWeeklyPlaner.Activate
    
    Application.ScreenUpdating = True
End Sub

It runs smoothly now

Cheers for all you guys input