VBA代码拆分excel

忙活两小时，终于帮老姐实现了拆分工作excel的需求，记录下，说不定以后可以用到。。 需求：一个excel文件工作簿可能包含多个工作表(比如sheetA，sheetB,sheetC),每个sheet里每一行都有一个地市字段，现需要根据地市拆分成不同的excel（每个excel包含sheetA，sheetB,sheetC，而且每个sheet里的记录都是同一个地市的）。    代码如下：  Sub 复制表()     Dim j%       For j = 1 To 21        ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".xlsm")(0) & j & ".xlsm"     Next Call 打开并关闭文件 End Sub Sub 打开并关闭文件() Dim wb As Workbook Dim m For m = 1 To 21     Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".xlsm")(0) & m & ".xlsm", True) Call 拆分(m) Sheets("sheet1").Visible = xlSheetVeryHidden wb.Close True Next End Sub Sub 拆分(m) Dim B1 Dim k% k = m     Sheets("KPI").Select     For B1 = 24 To 3 Step -1         If Cells(B1, 1) <> Sheets("sheet1").Range("A" & k).Value Then             Rows(B1 & ":" & B1).Select             Selection.Delete Shift:=xlUp         End If     Next B1          Sheets("大规模断站8月").Select     For B1 = 24 To 3 Step -1         If Cells(B1, 1) <> Sheets("sheet1").Range("A" & k).Value Then             Rows(B1 & ":" & B1).Select             Selection.Delete Shift:=xlUp         End If     Next B1          Sheets("大规模断站明细").Select     B1 = Range("A1").End(xlDown).Row 'b1等于a列有数据最后一行的行号     While Cells(B1, 5) <> "分公司"         If Cells(B1, 5) <> Sheets("sheet1").Range("A" & k).Value Then             Rows(B1 & ":" & B1).Select             Selection.Delete Shift:=xlUp         End If     B1 = B1 - 1  Wend End Sub PS：上述代码需要根据实际情况调整！！