Snasui Excel Forum

Code: Select all

'...Other code
For Each r In s.Cells(8, 5).Resize(10000, 4).SpecialCells(xlCellTypeConstants, 1)
    With Sheets("DB").Range("a" & Rows.Count).End(xlUp) _
    .Offset(1, 0)
        .Offset(0, 0).Value = s.Name
        .Offset(0, 1).Value = s.Cells(r.Row, 2).Value
        .Offset(0, 2).Value = s.Cells(r.Row, 3).Value
        .Offset(0, 3).Value = s.Cells(7, r.Column).Value
        .Offset(0, 4).Value = s.Cells(6, r.Column).Value
        .Offset(0, 5).Value = s.Cells(5, r.Column).Value
        .Offset(0, 6).Value = r.Value
    End With
Next r
'...Other code

Code: Select all

Sub CollectData()
Dim r As Range, s As Worksheet
With Sheets("DB")
.UsedRange.ClearContents
.Range("A1:G1").Value = Array("WS", "PN", "Desc", "Type", "No", "Y date", "Qty")
End With
For Each s In Worksheets
If s.Name <> "DB" Then
For Each r In s.UsedRange.SpecialCells(xlCellTypeConstants, 1)
With Sheets("DB").Range("a" & Rows.Count).End(xlUp) _
.Offset(1, 0)
.Offset(0, 0).Value = s.Name
.Offset(0, 1).Value = s.Cells(r.Row, 2).Value
.Offset(0, 2).Value = s.Cells(r.Row, 3).Value
.Offset(0, 3).Value = s.Cells(7, r.Column).Value
.Offset(0, 4).Value = s.Cells(6, r.Column).Value
.Offset(0, 5).Value = s.Cells(5, r.Column).Value
.Offset(0, 6).Value = r.Value
End With
Next r
End If
Next s
End Sub