Reorganizing data dumb through VBA code (autofilter then copy & paste loop)

[Super Emad]

Hello everyone,

I have an excel extracted file showing piping material spec code, item code, description, pipe size, unique number and other information that are not required in my report.
the below snapshot is showing the required format for my report, so I wrote it a code to create sheet for each piping spec and discerption (A-11132303 and Carbon Steel... in this case) and move the data to match the below table. However, I keep getting a 1004 Application-defined or object-defined error and I dont understand why. Hope someone can help. here is the code I wrote so far (Its still a work in progress but if it works once I can do it for the other components)

Sub copyspec()
Dim ws1 As Worksheet
Dim DestWs As Worksheet
Dim WSName As String
Dim NewWs As Worksheet
Dim headers() As Variant
Dim NextRow As Integer
Dim LastRow As Integer
Dim LastRow1 As Integer
On Error GoTo errHandler

Set ws1 = Worksheets("Sheet1")
LastRow = ws1.Cells(Rows.Count, 3).End(xlUp).Row
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

For i = 10 To LastRow
WSName = ws1.Cells(i, 1)
Set DestWs = Worksheets(WSName)
Set DestWs = ActiveSheet

Cells(1, 1).Value = "Specification"
Cells(1, 2).Value = ws1.Cells(i, 1)
Cells(1, 3).Value = ws1.Cells(i, 3)

Range("A2:H2").Merge
Range("A2:H2").HorizontalAlignment = xlCenter
Cells(2, 1).Value = "Pipes"

headers() = Array("Short Code", "Opt", "From", "To", "UOM", "Commodity Description", _
    "Commodity Code", "Notes")
For x = LBound(headers()) To UBound(headers())
Cells(3, 1 + x).Value = headers(x)
Next x

wsl.Range("A10:X10").AutoFilter Field:=1, Criteria1:=Range("A2")
wsl.Range("A10:X10").AutoFilter Field:=24, Criteria1:=Range("PIPE")
wsl.Range("D10:G1461").SpecialCells(xlCellTypeVisible).Select.Copy

ActiveSheet.Range("next row, 1").Paste


Next
Exit Sub

errHandler:

Worksheets.Add(, Worksheets(Worksheets.Count)).Name = WSName
Set NewWs = ActiveSheet

Resume
End Sub

 

[Candyman8019]

have you stepped through the code to see which line is giving you trouble?

 

[Super Emad]

have you stepped through the code to see which line is giving you trouble?

Hi, I was running the code as I was writing step by step and the error started showing when I added the following part:

wsl.Range("A10:X10").AutoFilter Field:=1, Criteria1:=Range("A2")
wsl.Range("A10:X10").AutoFilter Field:=24, Criteria1:=Range("PIPE")
wsl.Range("D10:G1461").SpecialCells(xlCellTypeVisible).Select.Copy

ActiveSheet.Range("next row, 1").Paste

 

[Candyman8019]

Perhaps try using the .value for your criteria1. For example:
Criteria1:=Range("A2").value

 

[Super Emad]

Perhaps try using the .value for your criteria1. For example:
Criteria1:=Range("A2").value

Hi, I tried it but still got the same error. I also tried Cells(1,2).value but also the same error

 

[Candyman8019]

Rather than .Select.Copy. Just do a . Copy

 

[Super Emad]

Rather than .Select.Copy. Just do a . Copy

I just tried it and didnt work

 

[Candyman8019]

This line might be a problem
ActiveSheet.Range("next row, 1").Paste
Next row should likely be NextRow to match the variable you have created earlier. And I’m thinking it shouldn’t be in quotations as well.