Run-time Error 6: Overflow - Copy Data from one worksheet to another

[jwb1012]

Hello, I am attempting to run the code below and it is giving me an error that says "Run-time Error 6: Overflow" it highlights the line of code below that is underlined and bolded. Any thoughts on how I can fix this issue?

The goal of the code is to do the following:

1. Unhide and activate Dest_Sh ("Destination")
2. If more than 1 row of data, then clear contents beginning in row 2
3. Unhide and activate Source_Sh ("Source")
4. Copy Source_Sh ("Source") from cells B10 to the last non-blank row in column C
5. Paste to Dest_Sh ("Destination") in the first non-blank row (i.e. row 2)

Sub DREO()
    Dim wb As ThisWorkbook
    Dim sh As Worksheet
    Dim CopyRng As Range
    
    Dim Dest_Sh As Worksheet
    Dim Dest_Start_Row As Integer
    Dim Dest_End_Row As Integer
    
    Dim Source_Sh As Worksheet
    Dim Source_Start_Row As Integer
    Dim Source_End_Row As Integer
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With

        '(1.) Clear contents from destination worksheet
        Set Dest_Sh = Sheets("Destination")
          [U][B]  Dest_End_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row[/B][/U]
            Dest_Start_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                If Dest_End_Row > 1 Then
                    Dest_Sh.Rows("2:" & Dest_End_Row).ClearContents
                End If
            
        '(2.) Copy source data and paste to destination worksheet
        Set Source_Sh = Sheets("Source")
            Source_End_Row = Source_Sh.Range("B" & Rows.Count).End(xlUp).Row
        
            On Error Resume Next
                Source_Sh.Visible = True
                Source_Sh.Activate
            On Error GoTo 0
            
                Set CopyRng = Source_Sh.Range("B10", "C" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("A" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
        
ExitTheSub:
    Application.GoTo Dest_Sh.Cells(1)
    ActiveWindow.DisplayGridlines = False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

 

[jwb1012]

Okay... I have adjusted the code as shown below and my overflow issue is gone. IT WORKED... but then.... when I try to run it a second time, it should clear out the old data and re-copy/paste from source to destination. The destination sheet is cleared, but the data isn't visible on my destination sheet.

This one is taking me for quite the spin. Would appreciate any guidance/advice.

Sub DREO()
    Dim wb As ThisWorkbook
    Dim sh As Worksheet
    Dim CopyRng As Range
    
    Dim Dest_Sh As Worksheet
    Dim Dest_Start_Row As Integer
    Dim Dest_End_Row As Integer
    
    Dim Source_Sh As Worksheet
    Dim Source_Start_Row As Integer
    Dim Source_End_Row As Integer
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With        '(1.) Clear contents from destination worksheet
        Set Dest_Sh = Sheets("Destination")
          [U][B]  Dest_End_Row = Dest_Sh.Cells(Rows.Count, "A").End(xlUp).Row[/B][/U]
            Dest_Start_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                If Dest_End_Row > 1 Then
                    Dest_Sh.Rows("2:" & Dest_End_Row).ClearContents
                End If
            
        '(2.) Copy source data and paste to destination worksheet
        Set Source_Sh = Sheets("Source")
            Source_End_Row = Source_Sh.Range("B" & Rows.Count).End(xlUp).Row
        
            On Error Resume Next
                Source_Sh.Visible = True
                Source_Sh.Activate
            On Error GoTo 0
            
                Set CopyRng = Source_Sh.Range("B10", "C" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("A" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
        
ExitTheSub:
    Application.GoTo Dest_Sh.Cells(1)
    ActiveWindow.DisplayGridlines = False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

 

[jwb1012]

Hmmm... okay, correction.... it is copy/pasting my data, but it is in row 10,000. When I run the code again, it pastes my data down even further (~row 11,000). When I run it a third time, it pastes my data even further down (~row 12,000).

I have tried using "EntireRow.Delete" instead of .ClearContents" but this doesn't solve the issue.... Any thoughts?

                If Dest_End_Row > 1 Then
                    Dest_Sh.Rows("2:" & Dest_End_Row).ClearContents
                End If

 

[Michael M]

works for me...only line I modified was

Set CopyRng = Source_Sh.Range("B10:C" & Source_End_Row)

 

[Michael M]

In that case do a CTRL + End on either / both sheets and see where the cursor ends up.....You may have some bloat, where a whole heap of blank rows need to be deleted