Copy filtered data from one workbook to another workbook

Rajesh2519 

Here is a VBA macro that will accomplish the task of filtering and copying data between workbooks as specified. The macro assumes the following:

• The data in the source workbook (Workbook_1) is located in Sheet1.
• The destination workbook (Workbook_2) has the destination sheet named Report.
• The final workbook (Workbook_3) has the destination sheet named Sheet1.

VBA Macro Code

The VBA code is untested and serves as an example only, please backup your file in advance as a precaution.

Sub CopyFilteredData()
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wbFinal As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim wsFinal As Worksheet
    Dim lastRow As Long
    Dim destLastRow As Long
    Dim sourceFilePath As String
    Dim destFilePath As String
    Dim finalFilePath As String

    ' Set the file paths (adjust these paths as necessary)
    sourceFilePath = "C:\Path\To\Workbook_1.xlsx"
    destFilePath = "C:\Path\To\Workbook_2.xlsx"
    finalFilePath = "C:\Path\To\Workbook_3.xlsx"

    ' Open the source workbook if not already open
    On Error Resume Next
    Set wbSource = Workbooks("Workbook_1.xlsx")
    On Error GoTo 0
    If wbSource Is Nothing Then
        Set wbSource = Workbooks.Open(sourceFilePath)
    End If
    
    ' Open the destination workbook if not already open
    On Error Resume Next
    Set wbDest = Workbooks("Workbook_2.xlsx")
    On Error GoTo 0
    If wbDest Is Nothing Then
        Set wbDest = Workbooks.Open(destFilePath)
    End If
    
    ' Open the final workbook if not already open
    On Error Resume Next
    Set wbFinal = Workbooks("Workbook_3.xlsx")
    On Error GoTo 0
    If wbFinal Is Nothing Then
        Set wbFinal = Workbooks.Open(finalFilePath)
    End If

    ' Set worksheets
    Set wsSource = wbSource.Sheets("Sheet1")
    Set wsDest = wbDest.Sheets("Report")
    Set wsFinal = wbFinal.Sheets("Sheet1")
    
    ' Clear previous data in the destination report sheet
    wsDest.Cells.ClearContents
    
    ' Apply filter for 'Pending' status and copy data
    With wsSource
        .AutoFilterMode = False
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:H" & lastRow).AutoFilter Field:=3, Criteria1:="Pending"
        .Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A1")
        .AutoFilterMode = False
    End With
    
    ' Apply filter for 'Completed' status and T-2 Working days from end date
    With wsSource
        .AutoFilterMode = False
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:H" & lastRow).AutoFilter Field:=3, Criteria1:="Completed"
        .Range("A1:H" & lastRow).AutoFilter Field:=5, Criteria1:="T-2 Working Days" ' Adjust this filter based on your requirement
        destLastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & destLastRow)
        .AutoFilterMode = False
    End With
    
    ' Apply filter for 'Exception' status and copy data
    With wsSource
        .AutoFilterMode = False
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:H" & lastRow).AutoFilter Field:=3, Criteria1:="Exception"
        destLastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
        .Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A" & destLastRow)
        .AutoFilterMode = False
    End With
    
    ' Copy columns F, G, H, J from report to Workbook_3 Sheet1 column B
    With wsDest
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("F2:F" & lastRow).Copy wsFinal.Range("B4")
        .Range("G2:G" & lastRow).Copy wsFinal.Range("C4")
        .Range("H2:H" & lastRow).Copy wsFinal.Range("D4")
        .Range("J2:J" & lastRow).Copy wsFinal.Range("E4")
    End With

    ' Clean up
    Application.CutCopyMode = False
    
    MsgBox "Data transfer complete!"
End Sub

Explanation

1. Initialize Workbooks and Worksheets:
• wbSource, wbDest, and wbFinal represent the source, destination, and final workbooks, respectively.
• wsSource, wsDest, and wsFinal represent the sheets within these workbooks.
2. Clear Previous Data:
• Clear any existing data in the Report sheet of Workbook_2 to ensure you are working with fresh data.
3. Filter and Copy Data:
   • Apply the filter.
   • Copy the visible rows (excluding headers).
   • Paste the copied data into the Report sheet in Workbook_2.
   • Remove the filter after copying the data.
• For each filtering criteria (Pending, Completed, and Exception):
4. Copy Specific Columns:
• Copy columns F, G, H, and J from the Report sheet of Workbook_2 to columns B, C, D, and E starting from row 4 in Sheet1 of Workbook_3.
5. Clean Up:
• Remove the copy mode to clean up the clipboard.
• Display a message box to indicate that the data transfer is complete.

Important Notes

• The macro will try to open the source and destination workbooks if they are not already open.For the VBA macro to work, both the source and destination workbooks need to be open. The macro interacts directly with the workbooks, so they must be accessible during the execution of the code.
• Ensure that the exact workbook and sheet names match those specified in the code.
• Adjust the filtering criteria for "T-2 Working Days" based on the actual logic required.
• Save your work before running the macro to prevent any accidental data loss.

This VBA macro should accomplish the task you described efficiently and accurately.

The text, steps and the code were created with the help of AI.

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and Like it!

This will help all forum participants.