Excel常见宏(简洁版).docVIP

清除剪贴板 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 判断指定文件是否已经打开() Dim x As Integer For x = 1 To Workbooks.Count If Workbooks(x).Name = 函数.xls Then 文件名称 MsgBox 文件已打开 Exit Sub End If Next MsgBox 文件未打开 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 另存所有工作表为工作簿 Sub 另存所有工作表为工作簿() Dim sht As Worksheet Application.ScreenUpdating = False ipath = ThisWorkbook.Path \ For Each sht In Sheets sht.Copy ActiveWorkbook.SaveAs ipath sht.Name .xls (工作表名称为文件名） ActiveWorkbook.SaveAs ipath sht.Name Trim(sht.[d15]) .xls （文件名称 D15单元内容） ActiveWorkbook.SaveAs ipath Trim(sht.[d15]) .xls （文件名称为D15单元内容） ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub 以指定单元内容为新文件名另存文件 Sub 以指定单元内容为新文件名另存文件() ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path \ Sheet1.[A1] End Sub 以当前日期为新文件名另存文件 Sub 以当前日期为新文件名另存文件() ThisWorkbook.SaveAs ThisWorkbook.Path \ Format(Now(), yyyymmdd) .xls End Sub Sub 以当前日期为名称另存文件() ActiveWorkbook.SaveAs Filename:=Date .xls End Sub 以当前日期和时间为新文件名另存文件 Sub