ต้องการสั่งให้ VBA ทำงานเหมือนกันทุกชีต

[yangkodza]

ในที่นี้ผมมีไฟล์งานลักษณะงานเหมือนกันหมายหลายสิบชีต
ต้องการแก้ไขงานครั้งเดียวทุกชีตต้องเขียน VBA อย่างไรครับ
ตอนนี้ที่ใช้ ผมใช้ Workbook_SheetActivate
แต่ปัญหาคือต้องกดชีตก่อน VBA จึงจะทำงานได้ครับ

Code: Select all

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveSheet.Unprotect
    Range("Z3").Select
    Columns("S:Y").Select
    Selection.Delete Shift:=xlToLeft
    Range("G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-24
    Range("T1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-27
    Range("U1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("T1").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("U1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("T:Y").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("V2").Select
End Sub

อยากได้แบบเปิด Excel มาแล้วจัดการเงื่อนไขที่เราต้องการจบในม้วนเดียวครับ คือจัดการทุกชีตเลย
ต้องปรับ code แบบไหนครับ

[snasui]

ศึกษาการ Loop ด้วย For Each...Next เข้ามาช่วยครับ

Code: Select all

'----Other code----
For each sh in Worksheets
     'Copy code ที่ต้องการจะให้ดำเนินการในแต่ละชีตมาวางไว้ที่ตรงนี้
Next sh
'----Other code---

[yangkodza]

ศึกษาการ Loop ด้วย For Each...Next เข้ามาช่วยครับ

Code: Select all

'----Other code----
For each sh in Worksheets
     'Copy code ที่ต้องการจะให้ดำเนินการในแต่ละชีตมาวางไว้ที่ตรงนี้
Next sh
'----Other code---

ประยุกต์ได้แล้วครับอาจารย์ แต่ติดตอนซีตสุดท้ายครับ
ต้องปรับ Code แบบไหนครับ

Code: Select all

Sub Demo2()
Dim i As Integer
For i = 1 To 30
Sheets(i).Select
    Range("D4:J4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "ขอบคุณครับ"
    Range("D5").Select

    Next i
    
End Sub

ตรง For i = 1 To 30 ค่า 30 เราปรับให้อ้างอิงเป็นค่าสุดท้ายได้ยังงัยครับ
ผมลองใช้ End ก็ไม่ได้ เลยไปไม่ถูกครับ

ขอบคุณครับ.xlsm

(65.41 KiB) Downloaded 11 times

[puriwutpokin]

30 เปลี่ยนเป็น For i = 1 To sheets.count

[yangkodza]

30 เปลี่ยนเป็น For i = 1 To sheets.count

ขอบคุณมากครับ
ทำได้แล้วครับ