一个excel文件分成多个文件

Sub Macro4()
'
' Macro4 Macro
'

'
Dim a, b, c, d, e, f, g, a1, a2 As Integer
Dim cname As String
Dim wb As Workbook
a = 2
c = 1
b = 1
d = 2
f = 0
a1 = 2

For b = 1 To 50
a = a + 1

If Cells(a, "c") <> Cells(a + 1, "c") Then



cname = Cells(a, "c")
g = a
e = a1 + 1

f = a - a1 + 3

Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Sheet1").Rows(c & ":" & d).Copy
wb.Worksheets("Sheet1").Rows("1:1").Insert Shift:=xlDown
ThisWorkbook.Worksheets("Sheet1").Rows(e & ":" & a).Copy
wb.Worksheets("Sheet1").Rows("3:3").Insert Shift:=xlDown
ThisWorkbook.Worksheets("Sheet1").Rows("351:352").Copy
wb.Worksheets("Sheet1").Rows(f & ":" & f).Insert Shift:=xlDown

wb.Worksheets("Sheet1").PageSetup.Orientation = xlLandscape
wb.Worksheets("Sheet1").Columns("E:E").ColumnWidth = 19.88
wb.Worksheets("Sheet1").Columns("F:F").ColumnWidth = 14.63
wb.Worksheets("Sheet1").Columns("D:D").ColumnWidth = 9.63
wb.Worksheets("Sheet1").Columns("H:H").ColumnWidth = 14.5
wb.Worksheets("Sheet1").Columns("I:I").ColumnWidth = 18.38
wb.Worksheets("Sheet1").Columns("E:E").ColumnWidth = 23.25
wb.Worksheets("Sheet1").Columns("I:I").ColumnWidth = 19.13

wb.SaveAs Filename:=ThisWorkbook.Path & "\" & cname & ".xlsx"

wb.Close SaveChanges:=True
a1 = a

End If
Next

End Sub

posted @ 2024-06-12 09:24  阴影中的人生  阅读(68)  评论(0)    收藏  举报