新人小白求助如何自动生成新的EXCEL

tonytan103

由于分别保密要求，需要将模板中不同银行的数据取出分别生成新的EXCEL，由于银行数量很多，手工处理太过麻烦，请求大神帮助！

liulang0808

http://club.excelhome.net/thread-1385473-1-1.html
这个帖子楼主可以参考下的

hodrag

这个简单，用activebook.saveas另存，然后分别删除

正宗新手

Sub 数据拆分()
    Dim arr, d As Object, wb As Workbook
    Dim bt, temp(), n%, s$, k, t, i&, j%
    arr = Sheet1.UsedRange
    bt = Sheets("???????").Range("A1:AD1")
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 19)
        If Not d.Exists(s) Then
            d(s) = i
        Else
            d(s) = d(s) & "," & i
        End If
    Next
    Application.DisplayAlerts = False
    For Each k In d.keys
        t = Split(d.Item(k), ",")
        ReDim temp(1 To UBound(arr, 2), 1 To UBound(t) + 1)
        For i = 0 To UBound(t)
            For j = 1 To UBound(arr, 2)
                temp(j, i + 1) = arr(t(i), j)
            Next
        Next
        Set wb = Workbooks.Add(xlWBATWorksheet)
        With wb.Sheets(1)
            .Range("A1:AD1") = bt
            .Range("A2").Resize(UBound(temp, 2), UBound(temp)) = WorksheetFunction.Transpose(temp)
        End With
        Columns("V:W").Select
    Selection.Delete Shift:=xlToLeft
        wb.Close True, ThisWorkbook.Path & "\" & k & ".xlsx"
    Next
    Application.DisplayAlerts = True
    Set wb = Nothing
   
    MsgBox "拆分完毕"
   
End Sub

sheets("??????")中的？？？？？改成你要拆分的这张表的名称。
s = arr(i, 19)  中的19改成你要拆分那一列是第几列你现在要拆B列那就改成s = arr(i, 2)

ty1014

看看，，，学习了