VBA: Find Criteria in Multiple Worksheets and Transfer Results to Seperate Worksheet

[TheMAP]

Hey everyone!

I am having some trouble writing a macro that will search sheet full of data, find cells that match a given criteria, copy other cells in the same row as the cell that matches the criteria, and then paste those cells in the same row on a different sheet. I need all the matching rows of cells to stack downward.

The tough part about this is that I need this same thing to happen on multiple sheets, with the same format, and at the same time. So that all given worksheets will search a range for a given criteria and stack all of the results together in the same worksheet.

I know this is complicated, but it would make my workbook run so much more smoothly. I figured out code that will work for one worksheet and inserted that below as a starting point. Thank you for any help you can provide!

Sub MoveData()    
    nextrow = 1
    For x = 4 To 104
        If Worksheets("Sheet1").Cells(x, 4).Value > 0 Then
            Worksheets("Sheet2").Cells(nextrow, 2).Resize(1, 12).Value = _
                Worksheets("Sheet1").Cells(x, 2).Resize(1, 12).Value
            nextrow = nextrow + 1
        End If
    Next x
End Sub

 

[JLGWhiz]

You don 't give a lot of details, but maybe you can adapt this code. This assumes that Sheet 2 will be the destination sheet and all other sheets in the workbook are the source sheets, with column D of the source sheets being the criteria range.

Sub copyStuff()
Dim sh As Worksheet, rng
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Sheet2" Then
            Set rng = Intersect(sh.UsedRange.Offset(3), sh.Range("B:M").EntireColumn)
            rng.AutoFilter 3, ">0"
            rng.Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp)(2)
            sh.AutoFilterMode = False
        End If
    Next
End Sub

 

[TheMAP]

Hey JLGWhiz,

Thanks for the response, but that code does pretty much the same thing as the code that I provided, but it also pulls formatting, which is not what I want and it just doesn't quite work in my workbook.

I apologize if I was not specific enough. I have three worksheets. One is blank and the other two are formatted the same, but contain different, but similar data. I need to search column "B" on both worksheets (the first column of data) and find any cell in that column that contains a number greater than 0 (zero). If true, I need to pull the entire row that contains that cell and copy it into the blank sheet. I will also need the data from the two data sheets to be in separate sections on the blank sheet. I am basically compiling data into one sheet to print and present and want to do so with out any unnecessary information (ie: rows of data that do not contain the criteria explained above).

 

[JLGWhiz]

The code posted in the OP indicates column D as the criteria column, This has been modified based on your post #3 to use column B as the criteria range. It also provides for the returns from each sheet to be separated by two blank rows. Again, it uses sheet 2 as the destination sheet. If that is not the correct destination sheet, then simply change it where indicated in the code to the correct sheet name in places with red font.

Sub copyStuff()
Dim sh As Worksheet, rng
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "[COLOR=#ff0000]Sheet2[/COLOR]" Then 'Change sheet2 to whatever your blank sheet name is
            Set rng = Intersect(sh.UsedRange.Offset(3), sh.Range("B:M").EntireColumn)
            rng.AutoFilter 1, ">0" 'Filters column B for greater than zero
            rng.Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets[COLOR=#ff0000]("Sheet2[/COLOR]").Cells(Rows.Count, 2).End(xlUp)(4)
            sh.AutoFilterMode = False
        End If
    Next
End Sub

 

[TheMAP]

Thanks again JLGWHhiz! Now i'm getting a 1004 error on the rng.Offset(1) line of your code. I adjusted the code to fit my workbook, but no cigar. I also messed with it a tad to see if I can make it work, but I can't seem to quite figure it out. Any ideas?

 

[JLGWhiz]

Thanks again JLGWHhiz! Now i'm getting a 1004 error on the rng.Offset(1) line of your code. I adjusted the code to fit my workbook, but no cigar. I also messed with it a tad to see if I can make it work, but I can't seem to quite figure it out. Any ideas?

Post the code as you are using it when you get the error message. I did not get an error when testing the original code. Usually, the 1004 error is a result of spelling or orther user generated conditions. I will need to see the code to determine if it is the code of something on your worksheet, lik merged cells, that might cause the problem.

 

[TheMAP]

Actually, I played with it again and figured it out, but this code dose not do what I need it to do. It looks like you have it set to filter each worksheet, then copy and paste the filtered results to the blank sheet. This is very labor intensive and will definitely cause excel to crash when I have the full data in the book. I don't want to reinvent the wheel here, I just need a simple code like the example in the original post, but one that works better.

 

[JLGWhiz]

Actually, I played with it again and figured it out, but this code dose not do what I need it to do. It looks like you have it set to filter each worksheet, then copy and paste the filtered results to the blank sheet. This is very labor intensive and will definitely cause excel to crash when I have the full data in the book. I don't want to reinvent the wheel here, I just need a simple code like the example in the original post, but one that works better.

I thought the filtering method would be faster than the looping. Sorry you can't use it.
regards, JLG