Conditional copy of row to other worksheet

[Closed]
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
Hello,

I have a 7 sheet workbook which contains a part number in column A of each sheet with details following it. I am trying to write a VBA code that will allow me to type the part number (ex. 1234) into an input box. Then the code should scan each of the sheets, picking each row which contains the given ID number and copying it to a new sheet in the same spreadsheet. In column D of each of these rows is the date that they were added to the spreadsheet, and I would also like to sort the rows of data copied by the program starting at the most recent addition to the spreadsheet.

Thank you very much in advance!


1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
802
insert a new worksheet and name it as "consol"

now try this macro (result will be in the inserted sheet)

if the new sheet is of different name modify the macro
I do not know configuration

Sub test()
Dim partnr, j As Integer, rdata As Range, filt As Range
partnr = InputBox("type the parat number e.g. 1234")
With Worksheets("consol")
.Cells.Clear
End With
For j = 1 To Worksheets.Count
If Worksheets(j).Name = "consol" Then GoTo nextj
With Worksheets(j)
Set rdata = .Range("a1").CurrentRegion
rdata.AutoFilter field:=1, Criteria1:=partnr
If WorksheetFunction.CountA(Range(rdata(1, 1), rdata(1, 1).End(xlDown)).SpecialCells(12)) = 1 Then GoTo nnext
Set filt = rdata.Offset(1, 0).Resize(rdata.Rows.Count - 1).SpecialCells(12)
filt.Copy
With Worksheets("consol")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
nnext:
.AutoFilterMode = False

nextj:



End With
Next j
With Worksheets("consol")
Set rdata = .Range("a2").CurrentRegion
rdata.Sort key1:=.Range("d1"), header:=xlNo
End With
End Sub