vba总表拆分多个子表格

Sub 总表拆分多个子表格()

Dim sht As Worksheet

Dim i As Integer '单元格的变量

Dim x As Integer '表的变量

Dim k As Integer '过度变量

Dim irow As Integer '行数变量

Dim y As Integer '列数变量

Dim sht1 As Worksheet '删除表格变量

y = InputBox("按第几列分")

Z = InputBox("要拆分的汇总表的名称是")

l1 = InputBox("第一列第一行的坐标是")

l2 = InputBox("最后一列的字母是")

'激活TB表

For Each wb In Workbooks

    s = wb.Name Like "*科目明细账&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("明细账").Cells(12, 26) Then

                 k = 1

            End If

        Next

    

        If k = 0 Then

        Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = Sheets("明细账").Cells(12, 26)

        End If

Next

'复制表格特定内容

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

'写入表格

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