vba總表拆分多個(gè)子表格
Sub 總表拆分多個(gè)子表格()
Dim sht As Worksheet
Dim i As Integer '單元格的變量
Dim x As Integer '表的變量
Dim k As Integer '過(guò)度變量
Dim irow As Integer '行數(shù)變量
Dim y As Integer '列數(shù)變量
Dim sht1 As Worksheet '刪除表格變量
y = InputBox("按第幾列分")
Z = InputBox("要拆分的匯總表的名稱是")
l1 = InputBox("第一列第一行的坐標(biāo)是")
l2 = InputBox("最后一列的字母是")
'激活TB表
For Each wb In Workbooks
? ? s = wb.Name Like "*科目明細(xì)賬&TB表*.xls*"
If s = True Then
? ? wb.Activate
End If
Next
irow = Sheets(Z).Range("e65536").End(xlUp).Row
? ? Application.DisplayAlerts = False
'建表
For i = 2 To irow
? ? ? ? k = 0
? ? ? ? For Each sht In Sheets
? ? ? ? ? ?
? ? ? ? ? ? If sht.Name = Sheets("明細(xì)賬").Cells(12, 26) Then
? ? ? ? ? ? ? ? ?k = 1
? ? ? ? ? ? End If
? ? ? ? Next
? ??
? ? ? ? If k = 0 Then
? ? ? ? Sheets.Add after:=Sheets(Sheets.Count)
? ? ? ? Sheets(Sheets.Count).Name = Sheets("明細(xì)賬").Cells(12, 26)
? ? ? ? End If
Next
'復(fù)制表格特定內(nèi)容
For x = 2 To Sheets.Count
? ? ? ? Sheets(Z).Range("e12 :ae " & irow).AutoFilter Field:=26, Criteria1:=Sheets(x).Name
? ? ? ??
? ? ? ? Sheets(Z).Range("e12 :ae " & irow).Copy Sheets(x).Range("a1")
? ? ? ??
Next
? ??
? ? Sheets(Z).Range("e12 :ae " & irow).AutoFilter
? ? Sheets(Z).Select
? ??
? ? MsgBox "已完成"
? ??
? ??
? ??
? ? '建表
Dim sht As Worksheet
Dim sht1 As Worksheet
For i = 1 To UBound(arr)
? ? ? ? k = 0
? ? ? ? For Each sht In Sheets
? ? ? ? ? ?
? ? ? ? ? ? If sht.Name = arr(i, 22) Then
? ? ? ? ? ? ? ? ?k = 1
? ? ? ? ? ? End If
? ? ? ? Next
? ??
? ? ? ? If k = 0 Then
? ? ? ? ? ? Sheets.Add after:=Sheets(Sheets.Count)
? ? ? ? ? ? Sheets(Sheets.Count).Name = arr(i, 22)
? ? ? ? End If
Next
Stop
'寫(xiě)入表格
Dim sht1 As Worksheet
n = 1
For i = 1 To UBound(arr, 1)
? ? ? ??
? ? If arr(i, 22) Like x Then '輸入條件1，條件2,先找到所在的行
? ??
? ? ? ? For j = 1 To UBound(arr, 2)
? ? ? ??
? ? ? ? Sheet1.Cells(n, j) = arr(i, j) '再把所有列的信息一并粘貼再新表格里
? ? ? ??
? ? ? ? Next j
? ? ? ??
? ? ? ? n = n + 1
? ? End If
Next
Stop
End Sub
