Sub shishi()

Dim k, i, j As Integer
Dim sht As Worksheet
For i = 1 To Sheet1.Range("a65536").End(xlUp).Row
k = 0 '事件賦值 用於發生於不發生指代
    For Each sht In Sheets
        
        If sht.Name = Sheet1.Range("a" & i) Then
        k = 1
        End If
    Next
        If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheet1.Range("a" & i)
        End If
    
Next



End Sub

Sheet1.Activate
Sheet1.Range("a1").Select '選擇前需要先啟用
application.goto Sheets(1).Range("A1") '啟用工作表和選擇單元格在同一語句完成
Resize(2, 3).Select 'resize只對於單元格 不對於可見區域

Sub shishi()

Dim i As Integer
Dim sht As Worksheet
For i = 2 To Sheet1.Range("a65536").End(xlUp).Row '單元格迴圈
    k = 0
    For Each sht In Sheets
    If sht.Name = Sheet1.Range("d" & i) Then
    k = 1
    End If
    Next
    If k = 0 Then
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)
    End If
    
Next
    
For Each sht In Sheets
    If sht.Name <> "資料" Then
    sht.Cells.ClearContents
    End If
    Sheet1.Activate '選擇前需要先啟用
    Sheet1.Range("a1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A1").AutoFilter Field:=4, Criteria1:=sht.Name
    Cells.Select
    If sht.Name <> "資料" Then
    Selection.Copy Sheets(sht.Name).Range("a1")
    End If
Next
    Sheet1.Activate
    Sheet1.Range("a1").Select
    Selection.AutoFilter



End Sub

Sub shishi()

Dim i As Integer
Dim sht As Worksheet
    Sheet1.Cells.ClearContents
    Sheet2.Range("a1").EntireRow.Copy Sheet1.Range("a1")
For Each sht In Sheets
For i = 2 To sht.Range("a65536").End(xlUp).Row
    If sht.Name <> "資料" Then
    sht.Range("a" & i).EntireRow.Copy Sheet1.Range("a" & Sheet1.Range("a65536").End(xlUp).Row + 1)
    End If
Next
Next

End Sub