Snasui Excel Forum

Code: Select all

Sub Button2_Click()
    Sheets("sheet2").Select
        Range("d5").Copy
        Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet3").Select
        Range("d5").Copy
        Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet4").Select
        Range("d5").Copy
        Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
        Range("A4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet5").Select
        Range("d5").Copy
        Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
        Range("A5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet6").Select
        Range("d5").Copy
        Sheets("ÃÇÁÊÃØ»ÂÍ´").Select
        Range("A6").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet   
    Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Value = sh.Range("d5").Value
            End With
        End If
    Next sh
End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet
    Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                .Range("a2", .Range("a" & .Rows.Count)).End(xlUp).Offset(1, 0).Value = sh.Range("d5").Value
            End With
        End If
    Next sh
End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet
    Worksheets("รวมสรุปยอด").Range("a2:a1000").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                 .Range("a3").Offset(Application.CountA(.Range("a3:a" & .Rows.Count)), 0).Value = sh.Range("d5").Value
            End With
        End If
    Next sh
End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet
    Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                 .Range("b4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("a4").Value
                 .Range("c4").Offset(Application.CountA(.Range("c4:c" & .Rows.Count)), 0).Value = sh.Range("b4").Value
                 .Range("d4").Offset(Application.CountA(.Range("d4:d" & .Rows.Count)), 0).Value = sh.Range("c4").Value
                 .Range("e4").Offset(Application.CountA(.Range("e4:e" & .Rows.Count)), 0).Value = sh.Range("d4").Value
                 .Range("f4").Offset(Application.CountA(.Range("f4:f" & .Rows.Count)), 0).Value = sh.Range("e4").Value
                 .Range("g4").Offset(Application.CountA(.Range("g4:g" & .Rows.Count)), 0).Value = sh.Range("f4").Value
            End With
        End If
    Next sh
End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet
    Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                 .Range("b4:g4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("a4:f4").Value
            End With
        End If
    Next sh
End Sub

Code: Select all

Sub AllTotal()

    StartRow = 2
    StartCol = 1
    
    TargetCell = "D5"
    
    SheetsCount = ThisWorkbook.Worksheets.Count
    CurrSheet = ActiveSheet.Name
    
'
' Clear Answer Area
'
    WorkRow = StartRow - 1
    For i = 1 To SheetsCount - 1
        WorkRow = WorkRow + 1
        Cells(WorkRow, StartCol).ClearContents
    Next i
    
'
' Put Answer
'
    WorkRow = StartRow - 1
    For i = 1 To SheetsCount
    
        If Worksheets(i).Name <> CurrSheet Then
           WorkRow = WorkRow + 1
           Cells(WorkRow, StartCol).Value = Worksheets(i).Range(TargetCell).Value
        End If
    
    Next i

End Sub

Code: Select all

Sub Button2_Click()
    Dim sh As Worksheet
    Worksheets("รวมสรุปยอด").Range("b4:g31").ClearContents
    For Each sh In Worksheets
        If sh.Name <> "รวมสรุปยอด" Then
            With Worksheets("รวมสรุปยอด")
                 .Range("b4").Offset(Application.CountA(.Range("b4:b" & .Rows.Count)), 0).Value = sh.Range("b1").Value
                 .Range("c4").Offset(Application.CountA(.Range("c4:c" & .Rows.Count)), 0).Value = sh.Range("b10").Value
                 .Range("d3").Offset(Application.CountA(.Range("d4:d" & .Rows.Count)), 0).Value = sh.Range("b3").Value
                 .Range("e4").Offset(Application.CountA(.Range("e4:e" & .Rows.Count)), 0).Value = sh.Range("b5").Value
                 .Range("f3").Offset(Application.CountA(.Range("f4:f" & .Rows.Count)), 0).Value = sh.Range("c7").Value
                 .Range("g3").Offset(Application.CountA(.Range("g4:g" & .Rows.Count)), 0).Value = sh.Range("d7").Value
            End With
        End If
    Next sh
End Sub