Copy and Paste by part number

[Carscomp]

Need help please.


New to VBA script. Tried looking over the web for some code and have not been able to find anything that i could get to work.


Issue: I have 1 work book. There are multiple Data sheets, each sheet is identified by date on tab ie: 01-01-2014. Each tab has a different date.


Each sheet has 4 columns that are named (Product Code, Internal Description, On Hand, Classification). This is in line A of every data sheet.


What i am trying to do is create a query in which I enter a part number(product code) in cell C1 of my query sheet(named Query).
The macro will search entire workbook and paste the data to the Query sheet, starting in cell B3. In Cell A3 it would have the tab name(date) that the data came from.
Each data sheet should have the same data in Product Code, Internal Description and Manufacturer. The only constantly changing data is "ON Hand" column.


The work book will be constantly update with new sheets.


The Product code column, of all data sheets are formatted GENERAL and product code is expressed as ="100-16125". Does this cause an issue?

 

[Fluff]

Welcome to the board
Give this a go

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Wsht As Worksheet
    Dim Qry As String
    Dim QrySht As Worksheet
    Dim CpyRws As Long


With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

    If Target.Address = "$C$1" Then
        Set QrySht = Worksheets("Query")
        Qry = Range("C1").Value
        For Each Wsht In Worksheets
            If Not Wsht.Name = "Query" Then
                If WorksheetFunction.CountIf(Wsht.Columns(1), Qry) > 0 Then
                    Wsht.Range("A1").AutoFilter Field:=1, Criteria1:=Qry
                    With Wsht.Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible)
                        .Copy QrySht.Range("B" & Rows.Count).End(xlUp).Offset(1)
                    End With
                    With QrySht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                        CpyRws = .row - 1
                        .Value = Wsht.Name
                        .Resize(QrySht.Range("B" & Rows.Count).End(xlUp).row - CpyRws).FillDown
                    End With
                    Wsht.Range("A1").AutoFilter
                End If
            End If
        Next Wsht
    End If

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

It needs to go in the sheet module
Right click the tab named "Query" select View Code and paste the above into the righthand window

 

[Carscomp]

This worked extremely well. The only issue is that it does not pull the tab data from the sheet where it is coming from

Sheet Date	Product Code	Internal Description	On Hand	Manufacturer
Sheet Date	6635	BUSHING COMPST 1.25 X 1 X 1L	0	POLYGON POLYGON CO
Sheet Date	6635	BUSHING COMPST 1.25 X 1 X 1L	0	POLYGON POLYGON CO
Sheet Date	6635	BUSHING COMPST 1.25 X 1 X 1L	0	POLYGON POLYGON CO
Sheet Date	6635	BUSHING COMPST 1.25 X 1 X 1L	0	POLYGON POLYGON CO
Sheet Date	6635	BUSHING COMPST 1.25 X 1 X 1L	2,308	POLYGON POLYGON CO

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[Fluff]

Could you put an apostrophe at the start of this line

                        '.Resize(QrySht.Range("B" & Rows.Count).End(xlUp).row - CpyRws).FillDown

& run it again?
This will check that the sheet name is coming in.

 

[Carscomp]

Done, thank you very much for your help.