Conditional copy of row to other worksheet

Closed
Mark - Jun 13, 2012 at 07:08 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 15, 2012 at 07:17 AM
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 response

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 15, 2012 at 07:17 AM
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

                
0