Filtering, copying and pasting

[Exceliscool123456789]

How do I create a macro that will filter for 3 specific values (highlighted in color) in a spreadsheet and based upon that value will copy and paste that information into different tabs in the same spreadsheet underneath the last row of data in each tab?

1). Filter the highlighted colors

2). Copy every row of data that contains that account # and paste it underneath the last row of data in another tab on the same spreadsheet (will be 3 tabs)

 

[kevin9999]

will be 3 tabs

Does that mean there's a separate tab for each of those AC numbers, and you want the values for each of them copied to their respective tabs? Do you want them to then be removed from the original sheet? How do you determine what those AC numbers will be - do they change or are they always the 3 you've described? Where in the 3 tabs do you want those values copied to - as in, which column?

It's not possible to copy from an image (and impossible to tell if your data starts in column A, or if the headers are in row 1). In future, could you please help those trying to help you by providing sample data using the XL2BB add in.

 

[Exceliscool123456789]

1). There will be a separate tab for each AC number:
-GL 10285
-GL 13456
-GL 10160

2). I only want the rows of data that contain that specific AC number to be copied and pasted into their respective tabs (listed above) which will be in a separate workbook

3). They dont have to be removed from the original sheet

4). These AC numbers are static and do not change

5). I want the new data to be pasted underneath the last row of data previously in that workbook tab

Let me know if you need a spreadsheet.

 

[kevin9999]

We're getting there. What is the name of the destination workbook, will it already be open when the code runs, and if not, do you want the code to automatically open it (if so, is it in the same folder as the source workbook) or do you want to prompt the user to open it?

 

[Exceliscool123456789]

I would like the code to have it open as it is being executed The destination wb is entitled Bank Transactions - September 2023 and the file pathway is J:\DEPT-FINANCE\MONTH END - F2023STUB\02 - SEP 2023\Banks. Could we create a code to have the open box on J:\DEPT-FINANCE\MONTH END - F2023STUB because every month it will change and want to be able to access it from this point, if possible.

 

[kevin9999]

OK, one step at a time. Firstly, let's check to make sure the copying is working properly. The following code will prompt the user to locate the destination file, and then copy the data to the appropriate sheets. I've assumes your source data starts in column A, with headers on row 1.

Option Explicit
Sub Copy_GL_Accs()
    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, s As String
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your Destination file", _
    FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then Set wb2 = Application.Workbooks.Open(FileToOpen)
    
    For Each a In Array("10285", "10160", "13456")
        s = "GL " & a
        With WsSrc.Range("A1").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
End Sub

 

[kevin9999]

Try this to default to your folder of choice:

Option Explicit
Sub Copy_GL_Accs_V2()
    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 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
End Sub

 

[Exceliscool123456789]

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