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