Run Through Cell value and pull data to Another workbook

[Haree]

Hello

Source Workbook : "Daily Sheet"
Source Location : Desktop

Destination Workbook : Return Items
Destination Location : D Drive

I have 12 sheets in the source workbook, one for each month
In each worksheet i have the following data
Column H: Date
Column I : Category
Column J : Party Name
Column K : Particulars
Column L: Bill Value
Column M: Quantity
Column N : Return Qty

If Column I : Category is "Returned Items" (I have a data validation) , i want that particular rows items from column H to Column N copied to the new workbook
I want this for all the worksheets in the source sheet
All the data can be together in the destination workbook

 

[Haree]

Date	Category
01-06-2020​
01-06-2020​	HDFC
01-06-2020​	HDFC
01-06-2020​	HDFC
01-06-2020​	Advance Closed
01-06-2020​	Advance Closed
01-06-2020​	Advance Closed
01-06-2020​	Advance Closed
01-06-2020​	Returned Items
01-06-2020​	Repairs Paid
01-06-2020​	Returned Items
01-06-2020​	Expenses
01-06-2020​	Google Pay
01-06-2020​	Expenses

 

[Haree]

Have sent you a copy, That Column might have blank cells also, ie I column

 

[ask2tsp]

Ok, didn't realize that Category could be empty. This version does a better job.

Sub collectReturnedItems_traced()
    'Purpose: Read all sheets in Source and copy the category "Returned Items" rows

    Dim ws      As Worksheet
    Dim rs      As Worksheet
    Dim source  As Workbook
    Dim nm          As String
    Dim sourceRow   As Long
    Dim returnRow   As Long
    Dim column      As Long
    Dim category    As String
    Dim nbrCopied   As Long
    
    nm = ThisWorkbook.Path & "\Source.xlsx"
    Set source = Workbooks.Open(nm)
    Debug.Print source.FullName, source.Worksheets.Count; " Sheets"
    
    returnRow = 2
    Set rs = ThisWorkbook.Worksheets(1)
    
    For Each ws In source.Worksheets
        Debug.Print ws.Name, ws.Range("I1").CurrentRegion.Address(0, 0)
        
        If ws.Name <> "Debtors" And ws.Name <> "Total" Then
            nbrCopied = 0
            
            For sourceRow = 2 To ws.Range("I1").CurrentRegion.Rows.Count
                category = ws.Cells(sourceRow, "I")
                
                If category = "Returned Items" Then
                    nbrCopied = nbrCopied + 1
                    For column = 8 To 14
                        rs.Cells(returnRow, column).Value = _
                            ws.Cells(sourceRow, column).Value
                    Next column
                    returnRow = returnRow + 1
                End If

            Next sourceRow
            Debug.Print , sourceRow - 2; " rows read, "; _
                        nbrCopied; " rows copied."
        End If
    Next ws
End Sub

 

[Haree]

Worked Like a charm, Thank you so much, helped me a lot .

 

[ask2tsp]

Glad I could help. To tidy things up you might consider to remove the "_traced" and comment out (put a ' in front of) the debug.print statements.