excel vba求一个 批量导出 的宏

如何批量导出excel里面的vba代码~

在编辑器中的文件，导出文件，不就全部出来了吗？
这个导出的文件还可以用导入来导入到你的新表中

你的语句完全符合语法规范，提示下标越界肯定是一个原因：工作簿或者工作表的名称没有完全一致，不用怀疑！

计算机是非常机械的，名字多一个、少一个任何字符（包括空格）都认为是不同的表，都可能会找不到，因此提示下标越界。

解决这类问题，一般是细心检查名字是否错误，实在看不出来，可以调试里面查看，例如我下图的例子（先切换工作簿可以查看各个工作簿的名字）：

我是一楼,对原代码修改了一下,并加了注释:
不过你格式的描述我不是很明白,你可以把代码修改一下
你可以发一个新生成的样表到ZXBWYZ@163.COM

工具→宏→宏:随便输个宏名(如AAA) :创建
然后下面内容复制进去,按F5即可:

Dim i As Long, j As Long, n1, n2, path_this As String
path_this = Replace(ThisWorkbook.Path & "\", "\\", "\")
'获取当前工作表的路径,为防止在根目录,用REPLACE处理了一下
Set n2 = ThisWorkbook.ActiveSheet: Set n1 = Workbooks.Add
'用N2表示当前表,N1表示新建表
n2.Activate: n2.Cells.Sort Key1:=Range("A1")
'把N2置为活动表 , 冒号后面是对表按A列进行排序
For i = 1 To n2.[A65536].End(xlUp).Row '从A列第一个到最后一个有效数据进行循环
n1.Sheets(1).Cells.Clear '把新表内容清空
n2.Activate '把原始表置为活动
j = WorksheetFunction.CountIf(Range("A:A"), Cells(i, 1)) '计算原始表中A列的重复,相同的放在一个文件里
n2.Range("1:1").Copy n1.Sheets(1).Cells(1, 1) '将原始表的表头复制到新表,这里可以该为任意你所需要的格式
n2.Range(i & ":" & i + j - 1).Copy n1.Sheets(1).Cells(2, 1) '将原始表的数据复制到新表
n1.SaveAs path_this & n1.Sheets(1).Cells(2, 1) & ".xls" '保存新表为要求的文件名
i = i + j - 1 '计算下一个的位置
Next i '进行下一个
n1.Close '完毕后关闭新表

注意:保证你的文件已保存,所有生成的文件与你的原文件在一个文件夹

Sub 表格_拆分()
'0 准备工作
Set acts = ActiveSheet

c = 2
dd = Selection.Column
'1 以第所选列为标志排序
If dd = 1 Then
acts.Columns(1).Select
acts.Sort.SortFields.Clear
acts.Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
acts.Sort.SortFields.Add Key:=Range("B:B"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With acts.Sort
.SetRange acts.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Else
acts.Columns(dd).Select
acts.Sort.SortFields.Clear
acts.Sort.SortFields.Add Key:=Columns(dd), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
acts.Sort.SortFields.Add Key:=Range("a:a"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With acts.Sort
.SetRange acts.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
b = Application.WorksheetFunction.CountA(acts.Columns(dd))
'2 新建工作簿
Set newb = Workbooks.Add
'3 新建工作表
'4 选中第二行到第8行 重命名新工作表为第一列第二行 复制数据到新工作表
'5 重复3、4
For i = 2 To b + 1
If i = 2 Or acts.Cells(i, dd) = acts.Cells(i - 1, dd) Then
Else
d = i - 1
Set news = newb.Sheets.Add(after:=newb.Worksheets(Worksheets.Count))
news.Name = acts.Cells(c, dd)
acts.Rows(1).Copy
news.Cells(1, 1).PasteSpecial
acts.Range(acts.Rows(c), acts.Rows(d)).Copy
news.Cells(2, 1).PasteSpecial
c = i
End If
Next
'6 删除原配的3个工作表
Application.DisplayAlerts = 0
newb.Sheets(1).Delete
newb.Sheets(1).Delete
newb.Sheets(1).Delete
Application.DisplayAlerts = 1
'7 激活新工作
newb.Sheets(1).Activate
newb.Activate
End Sub

使用方法 ,选中第一列任意单元格 执行宏

这是我自己编的

当然还有合并的 喜欢的话也给你

---

阳山县17068506365： excel 如何用 vba 批量提取指定工作表 - ？
错药十八： 放在thisbook的workbook的open方法下.dim n as integer dim names names=＂＂ for n=1 to worksheets().count-1 if worksheets(n).name like ＂(2)＂ then names=names&worksheets(n).name&char(13) next n msgbox names

阳山县17068506365： excel vba求一个 批量导出 的宏 - ？
错药十八： 我是一楼,对原代码修改了一下,并加了注释: 不过你格式的描述我不是很明白,你可以把代码修改一下 你可以发一个新生成的样表到ZXBWYZ@163.COM工具→宏→宏:随便输个宏名(如AAA) :创建 然后下面内容复制进去,按F5即可:...

阳山县17068506365： 如何用VBA将同一个文件夹下所有EXCEL表中的所有sheet表的数据导出到一个EXCEL中 - ？
错药十八： 新建一个工作薄,将所有EXCEL表的文件名填到A列中,复制下面VBA代码到工作薄中,保存为excel.xls后执行 Sub xlscopy() Application.ScreenUpdating = False'Arr数组由所有EXCEL文件名组成 arr = [A1:A10] For i = 1 To UBound(arr) ...

阳山县17068506365： excel用宏从一个工作薄中导出指定的几个工作表另存 - ？
错药十八： 把当前工作簿中的几个表复制到一个新工作簿中,用VBA一行代码就可以实现:Sheets(Array(＂输入表＂,＂输出表＂,＂年级排名表＂)).Copy 实现新建工作簿的另存为,需要两个语句,一个是选择文件名:fn = Application.GetSaveAsFilename 下一个语句就是保存:ActiveWorkbook.SaveAs fn 当然,这两个语句可能需要更细化,例如选择文件夹时候指定默认位置、文件类型,保存前检查文件是否覆盖、名字后缀是否正确等.

阳山县17068506365： 如何导出EXCEL批注？
错药十八： 批量导出Excel中的批注只能使用VBA代码来处理. Excel版本参考:2010 1、ALT+F11,调出VBE编辑器; 2、双击工作表名称,粘贴如下代码: Sub test1() On Error Resume Next For Each cel In Selection If Not cel.Comment Is Nothing Then i = i + 1 Cells(i, 1) = cel.Comment.Text End If Next End Sub 3、按下F5,执行代码; 4、返回工作表,查看效果(批注已全部提取到A列)

阳山县17068506365： 如何用ExcelVBA批量处理文件 - ？
错药十八： 方法有很多,一下是一个例子:作者:层序缘 链接:https://www.zhihu.com/question/59403671/answer/221091633 来源:知乎 著作权归作者所有.商业转载请联系作者获得授权,非商业转载请注明出处.sub BatchFiles Dim Filename as String,...

阳山县17068506365： Excel,VBA,批量操作,数据提取 - ？
错药十八： 用Dir函数,如: cPath = ThisWorkbook.Path & ＂\＂ cFile = ＂*.xls*＂ myFile = Dir(cPath & cFile) Do While myFile <> ＂＂ If myFile <> ThisWorkbook.Name Then

阳山县17068506365： 文件名,文件创建时间批量输出至文本或excel - ？
错药十八： 可以利用VBA写代码来实现,将文件名和文件修改时间批量输出至Excel中. 操作系统:win10;软件版本:Office2010 方法如下: 1.Alt+F11,输入代码如下: 代码注释已给出Sub main()ff = Dir(＂D:\*.*＂) '遍历D盘根目录下所有文件Do ...

阳山县17068506365： 跪求用VBA实现提取一个文件夹里的很多EXCEL表格固定SHEET到一新的EXCEL不同的SHEET中 - ？
错药十八： Excel批量重命名工作表(按1列数据命名):http://hi.baidu.com/jevonlee/blog/item/bb3509024ce635094afb5171.html Excel批量复制工作表:http://hi.baidu.com/jevonlee/blog/item/11f64395ce982e4dd0135ec3.html

阳山县17068506365： 如何用Excel VBA批量打印文件,excel vba 文件操作 - ？
错药十八： 如何用 Excel VBA 批量打印文件 有时候一个文件夹内有很多 Excel 文件,几十个,上百个,如果一个个的打开, 然后再打印,显然重复劳动,效率低下.Sub Copy_Data()Dim wb As Workbook, rng As Range, sht As WorksheetDim sht_Name, theDatesht_Name = ＂Sheet1＂ '假设所有报表文件中的数据都在 Sheet1Set sht = ActiveSheet '保存当前工作表对象fn = Dir(ThisWorkbook.Path & ＂\报表-*.xls＂,