按A列数据批量创建新表(控件按钮代码)

Private Sub CommandButton1_Click()

On Error Resume Next

Dim i%, j%

For i = 1 To [a65536].End(xlUp).Row

For j = 2 To Sheets.Count

If Cells(i, 1) = Sheets(j).Name Then

Exit For

End If

Next

Sheets.Add(after:=Sheets(Sheets.Count)).Name = Cells(i, 1)

Next

End Sub

清除剪贴板

Sub 清除剪贴板()

Application.CutCopyMode = False

Application.CommandBars("Task Pane").Visible = False

End Sub

批量清除软回车

Sub 批量清除软回车()

'也可直接使用Alt+10或13替换

Cells.Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, SearchOrder:= _

xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

当前文件另存到指定目录

Sub 当前激活文件另存到指定目录()

ActiveWorkbook.SaveAs Filename:="E:\信件\" & ActiveWorkbook.Name

End Sub

另存指定文件名

Sub 另存指定文件名()

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\别名.xls"

End Sub

以本工作表名称另存文件到当前目录

Sub 以本工作表名称另存文件到当前目录()

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xls"

End Sub

将本工作表单独另存文件到Excel当前默认目录

Sub 将本工作表单独另存文件到Excel当前默认目录()

ActiveSheet.Copy

ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & ".xls"

End Sub

以活动工作表名称另存文件到Excel当前默认目录

Sub 以活动工作表名称另存文件到Excel当前默认目录()

ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & ".xls", FileFormat:= _

xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _

, CreateBackup:=False

End Sub

Tags：subcommand