Trouble using VBA to copy multiple rows from one sheet to another

[TessieBear99]

Hi all, I'm hoping I can word this clearly because it's a bit of a muddle in my head.

I'm building a spreadsheet which has two sheets with a table on each sheet. At the end of each month, the user needs to be able to copy specific information from Sheet1 (called Planning) to Sheet2 (called Unplanned). I've created a button to allow this to be automated and it's almost working, but not quite.

Here is what needs to happen:
All rows in the table in Sheet1 which have the word "Unplanned" in column H need to be copied from column A:D and pasted into the first available row in the Sheet2 table.

Here is what is currently happening:
Only the last row in Sheet1 where the word "Unplanned" appears in column H is being selected and copied across to Sheet2.

Here is the code:

Private Sub cmdTransferUnplanned_Click()

' Start of question box and screen updating

    Dim answer As Integer

        answer = MsgBox("Are you sure?", vbQuestion + vbYesNo + vbDefaultButton2, "Transfer Unplanned")
        If answer = vbNo Then
        Exit Sub
    
        End If
    
    Application.ScreenUpdating = False


' Find, copy and paste data across

    Dim xWs As Worksheet
    Dim xCWs As Worksheet
    Dim xRg As Range
    Dim xRRg As Range
    Dim xC As Integer
    Dim xStr As String
    Dim LastCell As Range
    Dim LastCellColRef As Long
    Dim Destination As Range
    
    
    'Find first available empty row
    
    LastCellColRef = 1  'column number to look in when finding last cell
    
        If (Sheet2.Cells(Rows.Count, LastCellColRef).End(xlUp)) <> "" Then
        Set LastCell = Sheet2.Cells(Rows.Count, LastCellColRef).End(xlUp).Offset(1, 0)
        Else
        Set LastCell = Sheet2.Cells(Rows.Count, LastCellColRef).End(xlUp)
        End If
        
        Set Destination = LastCell
    
    
    'Find instances of "Unplanned" and copy across
    
    Set xWs = ActiveWorkbook.Worksheets("Planning")
    Set xCWs = ActiveWorkbook.Worksheets("Unplanned")
    Set xRg = xWs.Range("H:H")
    Set xRg = Intersect(xRg, xWs.UsedRange)
    
    xStr = "Unplanned"
    
    On Error Resume Next
    
        For Each xRRg In xRg
        If xRRg.Value = xStr Then
        Intersect(xRRg.EntireRow, xWs.Range("A:D")).Copy
        Destination.PasteSpecial xlPasteValues
             
        End If
    
    Next
    
    Application.CutCopyMode = False

' End of question box and screen updating

    Application.ScreenUpdating = True
    answer = MsgBox("Done!")

End Sub

I'm a beginner at this so I've figured bits and pieces out here and there. Any help would be greatly appreciated!

 

[kevin9999]

That looks like a table you have on the Planning sheet. If so, try the following code - but change the table name to match what you actually call it.

Option Explicit
Sub Tassie()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Planning")
    Set ws2 = Worksheets("Unplanned")
    Dim LRow As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
    
    With ws1.Range("A2").CurrentRegion
        .AutoFilter 8, "Unplanned"
        If ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row = 2 Then
            MsgBox "No Unplanned records found!"
            ws1.ListObjects("Table1").AutoFilter.ShowAllData        '<< change to actual table name
            Exit Sub
        End If
        .Offset(1).Resize(, 4).Copy ws2.Range("A" & LRow)
        ws1.ListObjects("Table1").AutoFilter.ShowAllData            '<< change to actual table name
    End With
End Sub

 

[TessieBear99]

That looks like a table you have on the Planning sheet. If so, try the following code - but change the table name to match what you actually call it.

Option Explicit
Sub Tassie()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Planning")
    Set ws2 = Worksheets("Unplanned")
    Dim LRow As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
   
    With ws1.Range("A2").CurrentRegion
        .AutoFilter 8, "Unplanned"
        If ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row = 2 Then
            MsgBox "No Unplanned records found!"
            ws1.ListObjects("Table1").AutoFilter.ShowAllData        '<< change to actual table name
            Exit Sub
        End If
        .Offset(1).Resize(, 4).Copy ws2.Range("A" & LRow)
        ws1.ListObjects("Table1").AutoFilter.ShowAllData            '<< change to actual table name
    End With
End Sub

Hi Kevin,

Thank you, yes they're in tables. I've updated it to include the actual table names and just tried running it as a separate module but I'm getting this error:

Any ideas?

Thanks,
Tess

 

[HongRu]

Set xRg = Intersect(xRg, xWs.UsedRange)

I suggest you to write like this:
Set xRg = Intersect(xRg, xWs.Range("H2").CurrentRegion)

"UsedRange" may happen something unexpected although it works well now.

Destination.PasteSpecial xlPasteValues

Here is the error.
Maybe you should write below instead:
Destination.Offset(i, 0).PasteSpecial xlPasteValues
i = i + 1

 

[TessieBear99]

I suggest you to write like this:
Set xRg = Intersect(xRg, xWs.Range("H2").CurrentRegion)

"UsedRange" may happen something unexpected although it works well now.


Here is the error.
Maybe you should write below instead:
Destination.Offset(i, 0).PasteSpecial xlPasteValues
i = i + 1

Thank you! I had to define i as Long but that worked, I appreciate it very much!

 

[kevin9999]

I

Hi Kevin,

Thank you, yes they're in tables. I've updated it to include the actual table names and just tried running it as a separate module but I'm getting this error:

View attachment 79688
View attachment 79689

Any ideas?

Thanks,
Tess

I see the problem. Try this instead:

Option Explicit
Sub Tassie2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Planning")
    Set ws2 = Worksheets("Unplanned")
    Dim LRow As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
    
    With ws1.ListObjects("tblPlanning").DataBodyRange
        .AutoFilter 8, "Unplanned"
        If ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row = 2 Then
            MsgBox "No Unplanned records found!"
            ws1.ListObjects("tblPlanning").AutoFilter.ShowAllData
            Exit Sub
        End If
        .Offset(1).Resize(, 4).Copy ws2.Range("A" & LRow)
        ws1.ListObjects("tblPlanning").AutoFilter.ShowAllData
    End With
End Sub

 

[TessieBear99]

I

I see the problem. Try this instead:

Option Explicit
Sub Tassie2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Planning")
    Set ws2 = Worksheets("Unplanned")
    Dim LRow As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
   
    With ws1.ListObjects("tblPlanning").DataBodyRange
        .AutoFilter 8, "Unplanned"
        If ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row = 2 Then
            MsgBox "No Unplanned records found!"
            ws1.ListObjects("tblPlanning").AutoFilter.ShowAllData
            Exit Sub
        End If
        .Offset(1).Resize(, 4).Copy ws2.Range("A" & LRow)
        ws1.ListObjects("tblPlanning").AutoFilter.ShowAllData
    End With
End Sub

This is amazing, thanks so much Kevin!

 

[kevin9999]

Always happy to help a fellow Aussie