VBA_操作單元03

'新建表

Sub xinjianbiao()
Dim sht As Worksheet
Dim k As Integer
For i = 1 To 3
    k = 0
    For Each sht In Sheets
        If sht.Name = Sheet1.Range("a" & i) Then   '遍歷所有表判斷是否重複，重複標記1
            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

 

Sub chaifenshengji()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer
irow = Sheet1.Range("a65536").End(xlUp).Row
Dim n As Integer
n = InputBox("你要根據哪列篩選？")
MsgBox ("你選擇第" & n & "列篩選")
'新建表
For i = 2 To irow
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 j = 2 To Sheets.Count
Sheet1.Range("a1:f" & irow).AutoFilter Field:=n, Criteria1:=Sheets(j).Name
Sheet1.Range("a1:f" & irow).Copy Sheets(j).Range("a1")
Next
Sheet1.Range("a1:f" & irow).AutoFilter
End Sub