excel拆分表格.txt

Sub 拆分() Dim sh As Worksheet Dim arr As Variant Dim brr() Dim i, s As Integer arr = Sheets("总表").UsedRange For Each sh In Worksheets ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2)) n = 0 If sh.Name <> "总表" Then For i = 3 To UBound(arr) If arr(i, 1) = sh.Name Then n = n + 1 For s = 1 To UBound(arr, 2) brr(n, s) = arr(i, s) Next s End If Next i End If sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(brr), UBound(brr, 2)) = brr Next sh End Sub