snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
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
You do not have the required permissions to view the files attached to this post.
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
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
You do not have the required permissions to view the files attached to this post.
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
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
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
ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
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
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
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
You do not have the required permissions to view the files attached to this post.
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