Snasui Excel Forum

Code: Select all

Sub Save()
'
' Save Macro
'

For i = 2 To Sheets.Count - 1
    Sheets(i).Select
    Application.Goto Reference:="OFFSET(R3C2,1,,COUNTA(C1)-2,5)"
    Selection.Copy
    Sheets("ÊÃØ»à·ÍÁ 1").Select
    Application.Goto Reference:="R4C2"
    If Range("B4") = "" Then Range("B4").Select Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next i

End Sub

Code: Select all

Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
With Worksheets("สรุปเทอม 1")
    Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
    For Each rs In rsAll
        For Each sh In Worksheets
            If sh.Name <> "สรุปเทอม 1" Then
                Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
                For Each rt In rtAll
                    If rt.Value = rs.Value Then
                        rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
                            rt.Offset(0, 1).Value
                        rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
                            rt.Offset(0, 2).Value
                        rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
                            rt.Offset(0, 3).Value
                        rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
                            rt.Offset(0, 4).Value
                    End If
                Next rt
            End If
        Next sh
    Next rs
End With

Code: Select all

Sub Macro1()
Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
    Range("C4:F18").Select
    Selection.ClearContents
    Range("C4").Select
With Worksheets("สรุปเทอม 1")
    Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
    For Each rs In rsAll
        For Each sh In Worksheets
            'If sh.Name <> "สรุปเทอม 1" Then      'ถูกต้องต้นฉบับ
            'If sh.Name <> "สรุปเทอม 1,ต.ค.2,พ.ย.,ธ.ค.,ม.ค.,ก.พ.,มี.ค.,สรุปเทอม 2,สรุปทั้งปี" Then 'ไม่ผ่าน
            'If sh.Name <> Worksheets.Count Then      'ถูกต้องต้นฉบับ  'ไม่ผ่าน
           If sh.Name <> Sheets(Array("สรุปเทอม 1", "ต.ค.2", "พ.ย.", "ธ.ค.", "ม.ค.", "ก.พ.", "มี.ค.", _
           "สรุปเทอม 2", "สรุปทั้งปี")) Then
            Sheets("สรุปเทอม 1").Activate
                            Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
                For Each rt In rtAll
                    If rt.Value = rs.Value Then
                        rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
                            rt.Offset(0, 1).Value
                        rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
                            rt.Offset(0, 2).Value
                        rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
                            rt.Offset(0, 3).Value
                        rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
                            rt.Offset(0, 4).Value
                    End If
                Next rt
            End If
        Next sh
    Next rs
End With
Application.ScreenUpdating = True
End Sub

Code: Select all

'Other code
If sh.Index >= 2 and sh.Index <= 7 Then
'Other code