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

 

[kevin9999]

This is my code below, any assistance would be greatly appreciated.

Looks similar to what you were provided with here:
Filtering, copying and pasting

Just a tip for future reference, when you say:

Thank you for your assistance, I will try it out and let you know

it pays to follow through with your commitment, otherwise volunteers may be less inclined to help you in future

 

[Exceliscool123456789]

You are right and will do for future. I did try it out but it was not the code I was looking for, could you assist?

 

[Exceliscool123456789]

Can anybody assist?

 

[kevin9999]

There's so much wrong with your code I won't bother trying to fix it, instead, here's an amended version of the code I provided to you in your previous post with a single amendment - instead of filtering on column F (as per your last requirement) it now filters on column D. Try it, and let me know what does/does not work! If you don't give feedback, I can't help you further.

Option Explicit
Sub Copy_GL_Accs_V3()
    Application.ScreenUpdating = False
    Dim WsSrc As Worksheet, wb2 As Workbook
    Set WsSrc = ThisWorkbook.Worksheets("Sheet1")     '<-- *** Change this to actual source data sheet name ***
    If WsSrc.AutoFilterMode Then WsSrc.AutoFilter.ShowAllData
    
    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
    
    For Each a In Array("10285", "10160", "13456")
        s = "GL " & a
        With WsSrc.Range("A1").CurrentRegion
            .AutoFilter 4, a                                        '<-- was Column F now column D
            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
End Sub

 

[Exceliscool123456789]

Thank you for your assistance and will do. Btw, what are some good references to study vba coding at a rudimentary level?

 

[kevin9999]

what are some good references to study vba coding at a rudimentary level?

There's a stack of free tutorials online if you do a Google search. One that I point people to as a good beginners' learning tool is this:
https://www.youtube.com/c/SiddharthRout/videos

 

[Exceliscool123456789]

I will look into them, thank you for letting me know.
The code when being run gives an error message after opening the file, please see below.

The source data is in another workbook which will need to be filtered on column D for the specific values listed and those rows need to be copied and pasted into their respective worksheets in the workbook from pathway "J:\DEPT-FINANCE\MONTH END - F2023STUB\".

I can provide examples of both workbooks if needed.

 

[kevin9999]

I will look into them, thank you for letting me know.
The code when being run gives an error message after opening the file, please see below.

View attachment 99818

The source data is in another workbook which will need to be filtered on column D for the specific values listed and those rows need to be copied and pasted into their respective worksheets in the workbook from pathway "J:\DEPT-FINANCE\MONTH END - F2023STUB\".

I can provide examples of both workbooks if needed.

Thank you for the feedback. To correct that kind of error, I really could do with seeing the actual files. Please share them via Google Drive, Dropbox or similar file sharing platform. Remember to make them available to anyone with the link.

 

[Exceliscool123456789]

Thank you for the feedback. To correct that kind of error, I really could do with seeing the actual files. Please share them via Google Drive, Dropbox or similar file sharing platform. Remember to make them available to anyone with the link.

1). The first image is the main spread where we want the raw data to be dumped into their corresponding sheets (GL 10285, GL 10266 & GL 10160 - they are highlighted below).

2a).The second image is the raw data where we want column D to be filtered on 10285, 10266 and 10160 and then copied and pasted into their corresponding sheets on the first image (GL 10285, GL 10266 & GL 10160). FYI...The header columns will be the same for each spread.

2b). The raw data file name always changes each morning when it is ran. I.e - The file name appears as FIN-BankRecData2023_10_12_060004. I believe that "10_12_" are the dates they are ran and everything will stay congruent except the year "2023" and the last numeric values at the end "060004"

3). Also, is there an attachment button for xlsm files on this platform?