Combineing specific rows from multiple sheets to one sheet

I have about 25 sheets in an excel file, all have the same layout with different info. The info is to do with stock in a shop. And each sheet is separate to an area of the shop, ie laptop, tv, washing machine etc. So one supplier can have products in more than one area. All sku codes are 7 digits long and the first 3 digits identify the supplier. The last 4 then are product specific.

What I want to do is have a drop down with the supplier's name, then this populates another cell with their 3 digit identity code (I have that part done).

This is where I can't work out what to do. I then need the info referring to that supplier pulled from every sheet and put into the sheet where the drop down box is. There are only 4 columns that are needed. These are A, B, C and D. Ideally I'd like them to move over 1, ie A to B, B to C, C to D and D to E. Then I'd like the name of the source sheet to go into A.

I can provide the file if necessary.

Here you go.

Product Listing.xlsx

Sub ConsolidateSheets1()

 Dim ms As Worksheet, ws As Worksheet, LR As Long, i As Long, NR&
 
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    
    On Error Resume Next
    
    If Not Evaluate("ISREF(COUNT!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "COUNT"
    Else
        Set ms = Sheets("COUNT")
        
        Sheets("COUNT").Range("A6:D" & Rows.Count).Clear
    End If
     
     'Worksheets(1).Rows(1).Copy ms.Range("A1")
 
 For Each ws In ThisWorkbook.Sheets
      With ws
         If ws.Name <> "COUNT" Then
             LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
             .Range("A5:D" & LR).Copy ms.Cells(Rows.Count, "B").End(xlUp).Offset(1)
              Rng = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
             ms.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Rng) = ws.Name
        End If
    End With
Next ws
    With ms
    .Cells.Columns.EntireColumn.AutoFit
    End With
    
      Application.CutCopyMode = 0
      Application.ScreenUpdating = 1
     Application.DisplayAlerts = 1
End Sub

@Visha, that just asks for an object???

@AB33, that copies all the info from all sheets. It is a start though. Thanks. I just need to separate out the rows I need.

Muttly,
Tell me exactly what rows and columns you wish to copy and I will adjust the code. I thought you want to copy 4 columns only.

Thanks. Basically at the top of the sheet you have a drop down list (I think in the original file is says A1 "129" and the B1 "Indesit" in "COUNT"). If you look at the product codes some start with 129. Therefore anything starting with 129xxxx should be copied in.

It doesn't have to populate the sheet when opened, Only when the drop down changes selection.

If you hit the drop down (B1) and change to "Samsung", "048" comes in to A1 and that should clear the sheet and pull 048xxxx from all sheets.

Muttly,
This is not a simple consolidation. I did not even see you have a sheet called "Data". I am sure you are referring the sheet name to these numbers. I have changed the B1, got the number in A1, but how does this number related to sheet name?
I have to go the sheet "Data" to relate this number so as to relate to sheet name. You also want auto consolidation if you change the value in B1. Right?

If you want I can put in an example of the result I want?

The sheet name is not referenced by the number. The number is the first 3 digits of the product code. The first 3 numbers of any product code refer to the supplier hence selecting Samsung returns 048. The ideal solution would then be all product codes that start 048 would populate the sheet.

BTW Data is an irrelevant name, it could be sausages for all that matter. The only place "Data" is referenced is the vlookup to return the 3 digit reference with regard to the Supplier name.

I hope that helps.

Attached required result.

Product Listing.xlsx

Muttly,
I am getting close understanding your request, but the auto issue is the sticking point. SAMSUNG which is in column A, is found in all sheets and found in sheet COUNT A1 as well. So you just want to consolidate all SAMSUNG's in to count sheet, but it is not going to auto. I mean by this: if you change the drop down to let's say 129, the code will not auto fill in the count sheet with that module, but if you have specific-fixed names you wish to consolidate, I will have a go, i.e let's all all SAMSUNG, or other products. Please let me know

I can live without the auto but the search must be based on the number in column D rather than the name in column A. Reason being not all products that are SAMSUNG come from 048. Some come from 003.

A great example is 129xxxx, it can be either Indesit or Hotpoint however for our purposes they come from the same supplier. Supplier is always priority over Manufacture.

Thanks again.

Muttly,
You mean column C, column D are prices while column C is a code. I am not sure which column is the supplier. You have model, Brand and code. Let say,you have three codes numbers for SAMSUNG in sheet DVD AND BLURAY PLAYERS 0482005,0482017,0482019. How do I know which number is for SAMSUNG? I suspect, any number which starts with 48 is SAMSUNG. Right? Assuming it is, you just want to consoldiate all 48 from each sheet only. 48 is the ID, or supplier name.

Ya, column C, sorry.

Our codes are 7 digits in length, eg 0482005. These are 2 part codes 048, 2005. 048 tells me Samsung. 2005 identifies the product.

The supplier is always the first 3 digits and the product id is always the last 4.

Okay! I have lost tracking this thread now. You want to consolidate all supplier with 048 from all sheets. Is this is the only supplier? Please clarifay. I know you want to copy 4 columns A-D only. Is there anything I am missing@

If you could do that for me I can modify the code after for each other supplier. Column A-D should become Column B-E. Then Column A should have the source sheet's name.

Try this one. I have also tried to use find function, but slower than looping through the cells

Sub ConsolidateSheets1()

 Dim ms As Worksheet, ws As Worksheet, LR As Long, i As Long, NR&
 
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    
    On Error Resume Next
    
    If Not Evaluate("ISREF(COUNT!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "COUNT"
    Else
        Set ms = Sheets("COUNT")
        
        Sheets("COUNT").Range("A6:D" & Rows.Count).Clear
    End If
 
 For Each ws In ThisWorkbook.Sheets
      With ws
         If ws.Name <> "COUNT" Then
             LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
             For i = 5 To LR
              If Trim(.Cells(i, 3).Value) Like "48*" Then
                .Cells(i, 1).Resize(, 4).Copy ms.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, 4)
                Rng = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
                ms.Cells(Rows.Count, 1).End(xlUp).Offset(1) = ws.Name
                End If
             Next i
        End If
    End With
Next ws
    With ms
    .Cells.Columns.EntireColumn.AutoFit
    End With
    
      Application.CutCopyMode = 0
      Application.ScreenUpdating = 1
     Application.DisplayAlerts = 1
End Sub

Right I've it sorted using a combination of code from here and google. Huge thanks to AB33 for the majority of the code, specifically that part I couldn't work out. This code now is fully automatic. If I select anything from the drop down list it updates cell B1 which in turn then calls the consolidation function. Inside that it clears the sheet excluding the headings, adds back in the relevant data, then adds borders and sizes the columns correctly.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:B1")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
    
    ' Display a message when one of the designated cells has been
    ' changed.
    ' Place your code here.
    MsgBox "You have changed supplier to " & Range("A1")
    Call ConsolidateSheets1
End If
End Sub

Sub ConsolidateSheets1()

Dim ms As Worksheet, ws As Worksheet, LR As Long, i As Long, NR&
Dim ss As String
 
ss = Range("B1")
ss = ss + "*"

Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

On Error Resume Next

If Not Evaluate("ISREF(COUNT!A1)") Then
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "COUNT"
Else
    Set ms = Sheets("COUNT")
    
    Sheets("COUNT").Range("A6:H" & Rows.Count).ClearContents
    Call Borders
End If
 
For Each ws In ThisWorkbook.Sheets
With ws
    If ws.Name <> "COUNT" And ws.Name <> "TV COUNT" And ws.Name <> "COMBI TV COUNT" Then
        LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        For i = 5 To LR
            If Trim(.Cells(i, 3).Value) Like ss Then
                .Cells(i, 1).Resize(, 4).Copy ms.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, 4)
                Rng = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
                ms.Cells(Rows.Count, 1).End(xlUp).Offset(1) = ws.Name
            End If
        Next i
    End If
End With
Next ws
    With ms
    .Cells.Columns.EntireColumn.AutoFit
    End With
    
    Application.CutCopyMode = 0
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = 1
    
    Call SetColumnWidth
End Sub

Sub Borders()

Dim iLoop As Integer

With Range("A1:H1000")
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    For iLoop = 7 To 12
        With .Borders(iLoop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Next
End With
End Sub

Sub SetColumnWidth()
    Columns("A").ColumnWidth = 27.86
    Columns("B").ColumnWidth = 13.57
    Columns("C").ColumnWidth = 42.14
    Columns("D:M").ColumnWidth = 10.14
End Sub

Muttly,
Welld done!
Just curious to know where does the event sheet is residing? Is on the sheet count?

Here you go. I've attached the full sheet.
From my understanding I would assume its in the current sheet (I could be wrong though, lol).

Just a little warning it is a macro enable sheet.

Product Listing-x.xlsm

Martin.

Martin,
Thanks for sending the attached!
Unfortunately, when I tried to download it, my PC warns me: the file has a virus and would not let me download it.

Thoughts as much. If you turn off your auto protect for 5 minutes you can download it then. But if not I've attached a non macro enabled worksheet so you can see the sheet then you can add in the macro from the code above on the "COUNT" sheet and try it out yourself. Product Listing-xy.xlsx

I've also attached it in a zip format so you could try downloading the macro version in a zip file. Your scanner will probably still pick it up though. plx.zip

Martin,
I have now got it from the zip. All fine and thanks!