Macro that searches column B in all sheets for all the different values and return in list

[pasqualebaldi]

I have a macro that looks for all the different values in column B and returns the different values only once in a list. I am trying to get this macro to do the same thing but to look in all the sheets column B and return all the different values onto on sheet. Here is the code I'm using to do it with one sheet.

Range(Range("B4"), Range("B4").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("I4"), Unique:=True

Thank you

[Kaper]

You can loop through all sheets, collecting the data the same way (unfortunately, as far as I remember advanced filter output has to go to the same sheet as data) and copying into "final sheet" then you can do the same in the final sheet.

Other option (if total number of used rows in do not exceed excel limits) you can copy all data into "final sheet" and then deduplicate it there.

anyway you will need a loop through all sheets skipping the one where output shall be placed, so something like:

dim ws as worksheet
for each ws in worksheets
  if ws.name <> "FinalResultsSheetName" then
   ' do all needed actions
  end if
next ws

[pasqualebaldi]

I am taking your advice and I'm trying to copy each dynamic list in column "B" from all the sheets and then paste them in one long list on the last sheet "Total Quantities" so I can run the advanced filter macro. I know I am doing something wrong though:

Sub find_all()

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Dim ws As Worksheet
For Each ws In Worksheets
  If ws.Name <> "Total Quantities" Then
  
   copylist = Cells(Rows.Count, "B").End(xlUp).Row
   Range("B4:B" & copylist).Copy Destination:=Sheets("Total Quantities").Range("A1:A" & LastRow)
   
  End If
Next ws

End Sub

[Kaper]

Try rearanging commands (last row changes after something is copied into the sheet)

Sub find_all_unique()

Dim ws As Worksheet, copylist as long, lastrow as long
For Each ws In Worksheets
  If ws.Name <> "Total Quantities" Then
  
   copylist = ws.Cells(Rows.Count, "B").End(xlUp).Row 'note ws. - you want to look in ws sheet
   LastRow = Sheets("Total Quantities").Cells(Rows.Count, "A").End(xlUp).Row 

   ws.Range("B4:B" & copylist).Copy Destination:=Sheets("Total Quantities").Range("A" & LastRow+1) 'note +1 (and again ws.)
   
  End If
Next ws
'and now dedupe
LastRow = Sheets("Total Quantities").Cells(Rows.Count, "A").End(xlUp).Row 
Sheets("Total Quantities").Range("A1:A"&lastrow).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub