将一张表格拆分成多张表格

问题：按照区域分到各个子表格中去

image.png

Sub chaifen()

Dim i, j, h As Integer



'For j = 2 To 31
'
    '创建表格
    'Sheets.Add after:=Sheets(Worksheets.Count)
    'With ActiveSheet
       ' .Name = Sheets("区域明细目录表格").Range("b" & j)
    'End With

    
'Next

        

For i = 7 To Sheets.Count

    '将数据分到各个表格中
    
    '1.筛选
    'Sheets("2019业务经理销售目标（最新）").Range("1:1").AutoFilter
    'Sheets("2019业务经理销售目标（最新）").Range("$A$1:$S$528").AutoFilter Field:=2, Criteria1:=Sheets(i).Name
    
    '2.复制粘贴
    'irow = Sheets("2019业务经理销售目标（最新）").Range("b65536").End(xlUp).Row
    'Sheets("2019业务经理销售目标（最新）").Range("a1:s" & irow).Copy Sheets(i).Range("a1")
    
    
    '添加合计
    '直接添加添加链接
    'Sheets("区域明细目录表格").Range("B" & i - 5).Select
    'Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=
        'Sheets("区域明细目录表格").Range("B" & i - 5).Value & "!A1", TextToDisplay:=Sheets("区域明细目录表格").Range("B" & i - 5).Value
        
    '复制链接
    'Sheets("广东").Range("A1").Copy Sheets(i).Range("A1")
    

    '添加合计
    'j = Sheets(i).Range("c65536").End(xlUp).Row
    'Sheets(i).Range("a" & (j + 2)) = "合计"
    'Sheets(i).Range("e" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("e2", "e" & j))
    'Sheets(i).Range("f" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("f2", "f" & j))
    'Sheets(i).Range("g" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("g2", "g" & j))
    'Sheets(i).Range("h" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("h2", "h" & j))
    'Sheets(i).Range("i" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("i2", "i" & j))
    'Sheets(i).Range("j" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("j2", "j" & j))
    'Sheets(i).Range("k" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("k2", "k" & j))
    'Sheets(i).Range("l" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("l2", "l" & j))
    'Sheets(i).Range("m" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("m2", "m" & j))
    'Sheets(i).Range("n" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("n2", "n" & j))
    'Sheets(i).Range("o" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("o2", "o" & j))
    'Sheets(i).Range("p" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("p2", "p" & j))
    'Sheets(i).Range("q" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("q2", "q" & j))
    'Sheets(i).Range("r" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("r2", "r" & j))
    'Sheets(i).Range("s" & (j + 2)) = Application.WorksheetFunction.Sum(Sheets(i).Range("s2", "s" & j))

    
    '对合计部分进行格式更改，采用的是先产生一个标准格式，然后刷新就好
    'Sheets("广东").Rows("25:25").Copy
    'Sheets("浙江").Select
    'Sheets(i).Rows(j + 2 & ":" & j + 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        'SkipBlanks:=False, Transpose:=False
    'Application.CutCopyMode = False
    
    '更改第s列格式
    'Sheets(i).Columns("S:S").EntireColumn.AutoFit

    
Next



End Sub

效果如下：

image.png