Snasui Excel Forum

Code: Select all

Dim rall As Range, r As Range
Dim sh As Worksheet, arrShts() As Variant
Dim j As Integer

For j = 2 To ThisWorkbook.Worksheets.Count
    ReDim Preserve arrShts(i)
    arrShts(i) = ThisWorkbook.Worksheets(j).Name
    i = i + 1
Next j
With Worksheets("หน้าหลัก")
    Set rall = .Range("A2", .Range("A100").End(xlUp))
End With
For Each r In rall
    If Not IsError(Application.Match(r.Value, arrShts, 0)) Then
        Worksheets(r.Value).Range("A2").Value = r.Offset(0, 1).Value
    Else
        MsgBox "คุณลืมเปลี่ยนชื่อชีทเป็น " & r.Value
    End If
Next r

Code: Select all

        If Worksheets(r.Value) = rall Then
        Worksheets(r.Value).Range("A2").Value = r.Offset(0, 1).Value
    Else
    If Worksheets(r.Value) <> rall Then
        MsgBox "คุณลืมเปลี่ยนชื่อชีท"
    End If
    End If

Code: Select all

Sub Button1_Click()
    Dim rall As Range, r As Range
    With Worksheets("หน้าหลัก")
        Set rall = .Range("A2", .Range("A100").End(xlUp))
    End With
    For Each r In rall
        Worksheets(r.Value).Range("a2:d2").Value = r.Offset(0, 1).Resize(1, 4).Value
    Next r
End Sub

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
        Set r = Worksheets("หน้าหลัก").Range("A2", Worksheets("หน้าหลัก").Range("A100").End(xlUp))
    For i = Worksheets.Count - i - 1 To r.Count
        With Worksheets("หน้าหลัก")
            .Cells(i + 3, 2).Copy: ActiveSheet.Range("b1").PasteSpecial Paste:=xlPasteValues
            End With
    Next i
End Sub

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
    With Worksheets("หน้าหลัก")
        Set r = .Range("A2", .Range("A100").End(xlUp))
    End With
    For i = Worksheets.Count - i - 1 To r.Count
        Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = r.Cells(i, 1).Value
            Worksheets("หน้าหลัก").Cells(i + 1, 2).Resize(, 4).Copy: ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteValues
    Next i
End Sub

Code: Select all

ActiveSheet.Name = r.Cells(i, 1).Value

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
    With Worksheets("หน้าหลัก")
        Set r = .Range("A2", .Range("A100").End(xlUp))
    End With
    For i = 1 To r.Count
        Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = r.Cells(i, 1).Value
            Worksheets("หน้าหลัก").Cells(i + 1, 2).Resize(, 4).Copy: ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteValues
    Next i
End Sub

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
    Dim sh As Worksheet
    With Worksheets("หน้าหลัก")
        Set r = .Range("A2", .Range("A100").End(xlUp))
    End With
    For i = 1 To r.Count
        Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = r.Cells(i, 1).Value
    Next i
    For Each sh In Worksheets
        If sh.Name <> "หน้าหลัก" Then
        If sh.Name <> "sheetcopy" Then
                Worksheets("หน้าหลัก").Range("b2") = sh.Range("a2").Value
    End If
    End If
    Next sh
End Sub

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
    With Worksheets("หน้าหลัก")
        Set r = .Range("A1", .Range("A65536").End(xlUp))
    End With
    For i = 1 To r.Count
        Worksheets("sheetcopy").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = r.Cells(i, 1).Value
    Next i
End Sub

Code: Select all

Sub Button1_Click()
    Dim i As Long
    Dim r As Range
    With Worksheets("หน้าหลัก")
        Set r = .Range("A1", .Range("A65536").End(xlUp))
    End With
    For i = 1 To r.Count
        Worksheets("sheetcopy").Copy(After:=Worksheets(Worksheets.Count)) _
            .Name = r.Cells(i, 1).Value
    Next i
End Sub