Macro for last 3 posts

Code:
Option Explicit
Sub Transfer_Sht1After() '  https://eileenslounge.com/viewtopic.php?p=280747#p280747
Rem 1 Source Worksheets info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row
'1b)  Any column in the visible data is taken in the next code line, the main reason being as we need to get the row indicie info
Dim Rng_v As Range: Set Rng_v = Ws1.Range("B1:B" & Lr1 & "").SpecialCells(xlCellTypeVisible) ' this gets just the range we see, so will be likely a range of lots of areas
    If Rng_v.Count = 1 Then ' case only header range visible
     MsgBox Prompt:="No rows to transfer.": Exit Sub
    Else ' there are visible rows to transfer
    Rem 2 building a single column array for the summed colums, and the wanted visible row indicies from the main range
    Dim aSum() As Variant: ReDim aSum(1 To Rng_v.Count - 1, 1 To 1) '  This will be a  column  array when applied to a worksheet
    Dim Rws() As Long: ReDim Rws(1 To Rng_v.Count - 1, 1 To 1) ' we need a  "virtical"  array containing the "seen" row indicies
    Dim Cel As Range
        For Each Cel In Rng_v '  These are the cells in the multi  Area  range of visible cells
            If Cel.Row > 1 And Cel.Value <> "" Then
            Dim I As Long
             Let I = I + 1
             Let aSum(I, 1) = Evaluate("=Sum('[" & ThisWorkbook.Name & "]Sheet1'!O" & Cel.Row & ":'[" & ThisWorkbook.Name & "]Sheet1'!Z" & Cel.Row & ")")
             Let Rws(I, 1) = Cel.Row '  This  puts the visible rows indicie in our array indicationg the rows we need from the worksheet
            Else
            End If
        Next Cel
    End If
' Destination workbook and worksheet
Dim Pth As String: Let Pth = ThisWorkbook.Path & Application.PathSeparator '  Const Pth = "C:\Users\L026936\Desktop\Excel\"      '<---- use own path
Const Wnm = "Workbook2_2b.xlsx"              'your destination workbook2  name
On Error Resume Next                                     '     https://eileenslounge.com/viewtopic.php?f=30&t=35861&start=20
Dim WbDest As Workbook
 Set WbDest = Workbooks(Wnm) ' will error if workbook is not yet open
    If Err.Number > 0 Then
     Workbooks.Open Filename:=Pth & Wnm ' we test to see if we have an error and if we do themn we kknow to open the workbook    On Error GoTo 0
     Set WbDest = ActiveWorkbook
    Else
    End If
''2a) Column indicies of the columns wanted from the data worksheet
Dim Clms() As Variant: Let Clms() = Array(2, 34, 3, 4, 5, 11, 34, 34, 27, 28, 29, 30, 31, 32, 33)
'2b) Typical arrOut()=AppIndex(arrIn(), Rws(), Clms())
 Let WbDest.Worksheets.Item(1).Range("B2").Resize(UBound(Rws(), 1), 15).Value2 = Application.Index(Ws1.Cells, Rws(), Clms())
'2c)(ii) Sums column
 Let WbDest.Worksheets.Item(1).Range("B2").Resize(UBound(Rws(), 1), 1).Offset(0, 7).Value2 = aSum()
End Sub