Conditional copy of row to other worksheet
Closed
Mark
-
13 Jun 2012 à 19:08
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 - 15 Jun 2012 à 07:17
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 - 15 Jun 2012 à 07:17
Related:
- Conditional copy of row to other worksheet
- Saints row 2 cheats - Guide
- How to delete a row in word - Guide
- Transfer data from one excel worksheet to another automatically - Guide
- Vba add worksheet - Guide
- Copy worksheet to another workbook vba - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday 14 June 2009
Status
Contributor
Last seen
7 August 2021
811
15 Jun 2012 à 07:17
15 Jun 2012 à 07:17
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
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