Copy Paste Noncontiguous Ranges from lo table in one workbook to lo table in another

[NorthbyNorthwest]

Hi, everyone. I have a listobject table in a workbook. I need to copy data from this source table and paste to target table in another workbook. The tables are identical in structure. My problem is I need to paste two noncontiguous ranges. Specifically, I need to copy/paste databody range columns B:CV and CZ:DA to next empty row in the target table. Is it possible to copy/paste all at once? I’ve been copying and pasting manually. So, I do first range, repeat steps to do second range. Sometimes I mess up and misalign the two parts. How can I achieve in code?

 

[NorthbyNorthwest]

Below is my code. It is not copying the second range. Can anyone assist?

Sub HardCopy()
Dim wsCopy1 As Range
Dim wsCopy2 As Range
Dim wsDest As Worksheet
Dim FinalRow As Long
Dim DestLastRow As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheet2.Activate
FinalRow = Cells(Rows.Count, 2).End(xlUp).Row - 5
Set wsCopy1 = Cells(6, 2).Resize(FinalRow, 100)
Set wsCopy2 = Cells(6, 104).Resize(FinalRow, 1)

Set wsDest = Workbooks("Destination Workbook Test.xlsm").Worksheets("All Records")
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

wsCopy1.Copy
wsDest.Range("B" & DestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy2.Copy
wsDest.Range("CZ" & DestLastRow).PasteSpecial Paste:=xlPasteValues

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

I think you might be overcomplicating it by trying to use resize.
Try this:

Sub HardCopy()
    Dim rngCopy1 As Range                                   ' Changed
    Dim rngCopy2 As Range                                   ' Changed
    Dim wsDest As Worksheet
    Dim FinalRow As Long
    Dim DestLastRow As Long
    Dim wsCopy As Worksheet                                  ' Added
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set wsCopy = Sheet2
    With wsCopy
        FinalRow = .Cells(Rows.Count, 2).End(xlUp).Row           ' Removed -5
        ' columns B:CV and CZ:DA
        Set rngCopy1 = .Range(.Cells(6, "B"), .Cells(FinalRow, "CV"))
        Set rngCopy2 = .Range(.Cells(6, "CZ"), .Cells(FinalRow, "DA"))
    End With
    
    Set wsDest = Workbooks("Destination Workbook Test.xlsm").Worksheets("All Records")
    DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
    
    rngCopy1.Copy
    wsDest.Range("B" & DestLastRow).PasteSpecial Paste:=xlPasteValues
    rngCopy2.Copy
    wsDest.Range("CZ" & DestLastRow).PasteSpecial Paste:=xlPasteValues
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[NorthbyNorthwest]

I think you might be overcomplicating it by trying to use resize.
Try this:

Sub HardCopy()
    Dim rngCopy1 As Range                                   ' Changed
    Dim rngCopy2 As Range                                   ' Changed
    Dim wsDest As Worksheet
    Dim FinalRow As Long
    Dim DestLastRow As Long
    Dim wsCopy As Worksheet                                  ' Added
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    Set wsCopy = Sheet2
    With wsCopy
        FinalRow = .Cells(Rows.Count, 2).End(xlUp).Row           ' Removed -5
        ' columns B:CV and CZ:DA
        Set rngCopy1 = .Range(.Cells(6, "B"), .Cells(FinalRow, "CV"))
        Set rngCopy2 = .Range(.Cells(6, "CZ"), .Cells(FinalRow, "DA"))
    End With
   
    Set wsDest = Workbooks("Destination Workbook Test.xlsm").Worksheets("All Records")
    DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
   
    rngCopy1.Copy
    wsDest.Range("B" & DestLastRow).PasteSpecial Paste:=xlPasteValues
    rngCopy2.Copy
    wsDest.Range("CZ" & DestLastRow).PasteSpecial Paste:=xlPasteValues
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Thanks so much for replying, Alex. Yes, after much stumbling around I came to the conclusion to abandon resize. I finally came up with working code, though it is not as elegant as yours. As always, I appreciate the many talented forum members who take time to respond.

Sub CopyParts()

Dim WB As Workbook

Dim wsCopy1 As Range

Dim wsCopy2 As Range

Dim wsDest As Worksheet

Dim FinalRow As Long

Dim DestLastRow As Long





Application.ScreenUpdating = False

Application.EnableEvents = False



'Check if target workbook is open

Set WB = GetWorkbookByNamePattern("*All Records.xlsm")

If WB Is Nothing Then

  MsgBox "Target workbook is not open."

  Exit Sub

Else

'do nothing

End If



'Part 1: Copy Details columns B:CV (2 - 100) to the target workbook

Sheet2.Activate

FinalRow = Cells(Rows.Count, 2).End(xlUp).Row - 5

Set wsCopy1 = Range(Cells(6, 2), Cells(FinalRow, 100))



Set wsDest = WB.Worksheets("Details")

DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

wsCopy1.Copy

wsDest.Range("B" & DestLastRow).PasteSpecial xlPasteValues



'Part 2: Copy Details columns CZ:DA (104 - 105) to the target workbook

Sheet2.Activate

FinalRow = Cells(Rows.Count, 105).End(xlUp).Row - 5

Set wsCopy2 = Range(Cells(6, 104), Cells(FinalRow, 105))



Set wsDest = WB.Worksheets("Details")

DestLastRow = wsDest.Cells(wsDest.Rows.Count, "DA").End(xlUp).Offset(1).Row

wsCopy2.Copy

wsDest.Range("CZ" & DestLastRow).PasteSpecial xlPasteValues



Application.Goto wsDest.Range("A1")

Application.EnableEvents = True

Application.ScreenUpdating = True

ThisWorkbook.Close Savechanges:=True

End Sub

Function GetWorkbookByNamePattern(Pattern As String) As Workbook

Dim WB As Workbook

 

  For Each WB In Application.Workbooks

    If WB.Name Like Pattern Then

      Set GetWorkbookByNamePattern = WB

      Exit Function

    End If

  Next WB

 

  Set GetWorkbookByNamePattern = Nothing

End Function

 

[Alex Blakenburg]

Thank you for the feedback. Glad I could help.
Just a couple of suggestions. Most people associate a ws prefix with a worksheet so using that for a range is more likely to confuse than enlighten.
I think Resize works better when you are trying to match your output range to your source range or to an array. For the intial data range having the first and last row or something like a range of currentregion is easier.