excel批量创建表格*

发布网友 发布时间：2022-04-19 23:26

我来回答

共4个回答

热心网友 时间：2023-04-23 07:59

Sub 批量创建表格()
Application.ScreenUpdating = False
Set 原表 = ActiveSheet
Workbooks.Add
ActiveWindow.Zoom = 140
Cells.Font.Size = 6
'Cells.ShrinkToFit = True
Cells.ColumnWidth = 11 '///////增加行
模板文件名 = Environ("TEMP") & "\模板.xls"
ActiveWorkbook.SaveAs 模板文件名
ActiveWorkbook.Close
For 行 = 原表.UsedRange.Row To 原表.UsedRange.Row + 原表.UsedRange.Rows.Count + 1
数字 = 原表.Cells(行, 1)
If 数字 <> "" Then
Workbooks.Add 模板文件名
文件名 = "C:\" & 原表.Cells(行, 1) & ".xls"
ActiveWorkbook.SaveAs 文件名
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
End Sub

热心网友 时间：2023-04-23 07:59

我把新建的文件内所有工作表都做了相同的修改，应该符合你的要求了，试试看：

Sub 批量创建表格()

Application.ScreenUpdating = False
Set 原表 = ActiveSheet
Workbooks.Add
For i = 1 To Sheets.Count
Sheets(i).Select
Sheets(i).Cells.Select
Selection.ColumnWidth = 11
Selection.RowHeight = 13.5
ActiveWindow.Zoom = 140
Sheets(i).Cells.Font.Size = 6
Sheets(i).Cells.ShrinkToFit = True
Sheets(i).Cells(1, 1).Select
Next
Sheets(1).Select
模板文件名 = Environ("TEMP") & "\模板.xls"
ActiveWorkbook.SaveAs 模板文件名
ActiveWorkbook.Close
For 行 = 原表.UsedRange.Row To 原表.UsedRange.Row + 原表.UsedRange.Rows.Count + 1
数字 = 原表.Cells(行, 1)
If 数字 <> "" Then
Workbooks.Add 模板文件名
文件名 = "C:\" & 原表.Cells(行, 1) & ".xls"
ActiveWorkbook.SaveAs 文件名
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True

End Sub

热心网友 时间：2023-04-23 08:00

简单，你如果还有那个宏的话直接编辑ActiveWindow.Zoom = 140
Cells.Font.Size = 6
这里加一个控制段
Selection.ColumnWidth = 11
即可

热心网友 时间：2023-04-23 08:00

将 工作表 选中

单击 格式 菜单 下的 列 选择 列宽 输入 11 即可