Snasui Excel Forum

Code: Select all

Sub CollectData()
Dim r As Range, r1 As Range, r2 As Range
Dim whs As Worksheet
Application.ScreenUpdating = False
For Each whs In Worksheets
    If whs.Name <> "ผลลัพธ์" Then
            Set r = Worksheets("ผลลัพธ์").Range("A" & Rows.Count) _
                .End(xlUp).Offset(1, 0)
            With whs
                Set r1 = .Range("B2", .Range("C" & Rows.Count).End(xlUp))
                Set r2 = .Range("F2", .Range("G" & Rows.Count).End(xlUp))
            End With
            If r1.Range("A1") <> "" Then
                r1.Copy
                r.PasteSpecial xlPasteValues
            End If
            Set r = Worksheets("ผลลัพธ์").Range("A" & Rows.Count) _
                .End(xlUp).Offset(1, 0)
            If r2.Range("A1") <> "" Then
                r2.Copy
                r.PasteSpecial xlPasteValues
            End If
        End If
Next whs
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub