Filtering values from data source and pasting it into a second workbook

[Exceliscool123456789]

Hi,

I'm having trouble running a code that will extract certain values (10285, 10160 & 13456) from the data source sheet and paste it into different tabs on a second workbook (wb.2) in the first available row (rolling tally). This is my code below, any assistance would be greatly appreciated.


Code objective:

1). Open data source sheet and label it as wb.1
2). Within the data source sheet, filter on column D for values - 10285, 10160 & 13456
3). Activate the second workbook in a specific folder - J:\DEPT-FINANCE\MONTH END - F2023STUB
4). The second workbook will be titled "Bank Transactions - MMM YYYY" in xlsm format
6a). Each row of data pertaining to that specific value in workbook 1 (10285, 10160 & 13456) should be pasted into their respective tabs underneath the first available row in the second workbook.
6b). Tabs: GL10285
GL10160
GL13456

Dim file1 As String
Dim file2 As String
Dim wb As Workbook
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim lr1 As Long
Dim lr2 As Long

' Loop through all open workbooks to identify Datadump file
For Each wb In Application.Workbooks
If Left(wb.Name, 8) = "FIN-BANK" And Right(wb.Name, 3) = "csv" Then
Set wb1 = wb
End If
Next wb

For Each a In Array("10285", "10160", "13456")
s = "GL " & a
With WsSrc.Range("D1").CurrentRegion
.AutoFilter 6, a
If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
.Offset(1).Resize(.Rows.Count - 1).Copy _
wb2.Worksheets(s).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
.AutoFilter
End With
Next a
Application.ScreenUpdating = True

' Browse to open Bank Transactions File
file2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsm*),*.xlsm*", Title:="Bank Transactions")
Set wb2 = Workbooks.Open(file2)

wb1.Activate
Range("A1:N" & lr1).Copy
wb2.Activate
Sheets("GL10266").Activate
Range("A" & lr2 + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Close original CSV file
wb1.Close

' Save update Excel file
wb2.Save


End Sub

 

[Exceliscool123456789]

Sorry for the late response as well, was on vacation enjoying Canadian Thanksgiving.

 

[kevin9999]

Please share your files via Google Drive, Dropbox or similar file sharing platform, and remember to make them available to anyone with the link.

 

[Exceliscool123456789]

How do I do that on this platform?

 

[kevin9999]

How do I do that on this platform?

You don't do it 'on this platform' you do it on the platform you chose to share the files with, then you post the link to the files here.

 

[kevin9999]

How do I do that on this platform?

Once you've saved your files to a file sharing platform, come back here and in a new post on this thread, select the 'Link' icon from the menu and post the link to it. Here's an example:
fast fill.xlsm
Link icon:

 

[Exceliscool123456789]

Bank transaction spread

Raw data sheet

 

[kevin9999]

Thank you

 

[kevin9999]

I think the problems here began with your initial post. You confused which workbook was which, and the tabs you specified weren't quite right. That aside, I amended the code from my previous post & tested it. It seemed to do what you wanted (once I swapped the workbook references & adjusted the sheet names) and the link to the result is here:
Bank transaction spread edited.xlsm

Here is the edited code:

Option Explicit
Sub Copy_GL_Accs_V4()
    Application.ScreenUpdating = False
    Dim WsSrc As Worksheet, wb2 As Workbook
    Dim a, FileToOpen As String, s As String, filePath As String, dialog As FileDialog
    Set dialog = Application.FileDialog(msoFileDialogFilePicker)
    With dialog
        .AllowMultiSelect = False
        .InitialFileName = "J:\DEPT-FINANCE\MONTH END - F2023STUB\"
        .Show
        If .SelectedItems.Count <> 0 Then
            filePath = .SelectedItems.Item(1)
            FileToOpen = Right$(filePath, Len(filePath) - InStrRev(filePath, "\"))
            Set wb2 = Application.Workbooks.Open(FileToOpen)
        Else
            MsgBox "No file selected"
            Exit Sub
        End If
    End With
       
    Set WsSrc = wb2.Worksheets(1)
    For Each a In Array("10285", "10266", "10160")
        s = "GL " & a
        With WsSrc.Range("A1").CurrentRegion
            .AutoFilter 4, a
            If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
                .Offset(1).Resize(.Rows.Count - 1).Copy _
                ThisWorkbook.Worksheets(s).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
            .AutoFilter
        End With
    Next a
    Application.ScreenUpdating = True
End Sub