永发信息网

我想把一个文件夹里几百个独立的EXCEL表格中sheet1数据 全部复制到另一个新建的EXCEL表格中sheet1工作表

答案:1  悬赏:40  手机版
解决时间 2021-02-26 21:35
  • 提问者网友:謫仙
  • 2021-02-26 10:40
我想把一个文件夹里的几百个独立的EXCEL表格中sheet1的数据 全部复制到另一个新建的EXCEL表格中sheet1工作表,做一个汇总。 所有表格中的列数都是9列,行数有多有少。想把数据按照从上到下的顺序复制过去,但是一个一个复制耗时耗力,有没有什么便捷的方法,求大神指教。刚刚提问了下,点错提交了。
最佳答案
  • 五星知识达人网友:拜訪者
  • 2021-02-26 11:21
Option Explicit
Sub mergeonexls() '合并多工作簿中指定工作表
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, l As Integer, h As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _
       Title:="Excel选择", MultiSelect:=True)
Set t = ThisWorkbook
Set ts = t.Sheets(1) '指定合并到的工作表,这里是第一张工作表
l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For Each x1 In x
If x1 <> False Then
 Set w = Workbooks.Open(x1)
 Set wsh = w.Sheets(1) '指定所需合并工作表,这里是第一张工作表
 h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row
 If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
 wsh.UsedRange.Copy ts.Cells(1, 1)
 Else
 wsh.UsedRange.Copy ts.Cells(h + 1, 1)
 End If
 w.Close
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub mergeeveryonexls() '将多个工作簿下的工作表依次对应合并到本工作簿下的工作表,即第一张工作表对应合并到第一张,第二张对应合并到第二张……
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _
       Title:="Excel选择", MultiSelect:=True)
Set t = ThisWorkbook
For Each x1 In x
If x1 <> False Then
 Set w = Workbooks.Open(x1)
 For i = 1 To w.Sheets.Count
If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)
 Set ts = t.Sheets(i)
 Set wsh = w.Sheets(i)
 l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column
 h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row
 If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
 wsh.UsedRange.Copy ts.Cells(1, 1)
 Else
 wsh.UsedRange.Copy ts.Cells(h + 1, 1)
 End If
 Next
 w.Close
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub把此代码,写到要合并的excel文件中。

OK后,打开几个要合并的excel文件,,运行该代码,即可。合并过来。
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
点此我要举报以上问答信息
大家都在看
推荐资讯