把同一个目录下的多个EXCEL的所有工作表(汇总表除外)的a1-p1区对下所有数据COPY并一个新的工作表内。

发布网友发布时间：2022-05-05 10:51

共1个回答

热心网友时间：2023-10-05 13:59

Option Explicit
Sub 合并生成报表()
Dim i As Integer
Dim j As Integer
Dim N As Integer
Dim Filename(100) As String
Dim Stemp As String
Dim sFile As String
Dim FileCount As Integer
sFile = ActiveWorkbook.Name
With Application.FileDialog(msoFileDialogOpen)
.Title = "选择文件（可多选）"
.AllowMultiSelect = True
.Filters.Add "Excel Files", "*.xls"
.FilterIndex = 2 '默认的文件筛选条件的索引号
.Show
FileCount = .SelectedItems.Count
If FileCount = 0 Then Exit Sub
Filename(1) = .SelectedItems(1)
For i = 1 To FileCount
Filename(i) = .SelectedItems(i)
Next i
End With

For i = 1 To FileCount
Workbooks.Open (Filename(i))
For j = 1 To ActiveWorkbook.Sheets.Count
Sheets(j).Activate
N = ActiveSheet.UsedRange.Rows.Count
Stemp = "A1" & ":P" & N 'A1¬P1以下所有数据
Range(Stemp).Select
Selection.Copy
Workbooks(sFile).Activate
N = ActiveSheet.Range("A65536").End(xlUp).Row
If N = 1 Then N = 0
Cells(N + 1, 1).Select
ActiveSheet.Paste
Stemp = Right(Filename(i), Len(Filename(i)) - InStrRev(Filename(i), "\"))
Workbooks(Stemp).Activate
Next j
ActiveWorkbook.Close
Next i
End Sub追问不行运行无效，怎么办啊？运行到这就没下文了ActiveWorkbook

追答你不会是在VB里面运行吧，这个是在excel的VBA编辑器里面运行的哦

参考资料：http://zhidao.baidu.com/question/391185636.html?oldq=1

来自：求助得到的回答