按ALT+F11打开VBA编辑窗口,在左边列表栏右键选择插入模块,粘贴以下代码 然后返回工作表ALT+F8 选中,执行
Sub hb()
Application.ScreenUpdating = False
Dim EndrowHZ, ShtCount, EndRow, EndCol As Long
Sheets.Add
ActiveSheet.Name = "汇总"
ShtCount = Worksheets.Count
For n = 2 To ShtCount
Sheets(n).Activate
EndRow = [A65536].End(xlUp).Row
EndCol = [iv1].End(xlToLeft).Column
For i = 2 To EndRow
EndrowHZ = EndrowHZ + 1
For ii = 1 To EndCol
If EndrowHZ = 1 Then i = 1
Sheets("汇总").Cells(EndrowHZ, ii) = Cells(i, ii)
Next ii
Next i
Next
Sheets("汇总").Activate
Application.ScreenUpdating = True
End Sub
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)
Rows("3:65536").Clear '清空汇总表
.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 = "AR5" & ":BG" & N 'D5-S5以下所有数据
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
Subad()
Fori=1To20
Worksheets("sheet"&i).Range("2:18").Copy_
Worksheets("sheet21").Range("a"&((i-1)*17+1))
Nexti
EndSub
-------------
要求:
1、表名sheet1、sheet2、……sheet21
2、数据汇总表名:sheet21
---------------
其他问题,Hi我,或留消息