第一步:
新建一个工作簿,后缀为xls
按alt+F11
把一下代码贴进去
Option Explicit
Sub 批量合并工作簿2()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String
Dim MyDir As String
MyDir = ThisWorkbook.path & ""
ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = MyDir
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Text = Null And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Wkb = Nothing
Set LastCell = Nothing
End Sub
复制代码
按f5运行
完成后再sheet1里面的A1单元格输入以下公式,下拉
B1单元格也用这个公式,但是公式的B5修改为B10即可
祝您成功!
=INDIRECT("'Sheet 24"&ROW(A26)&"'!B5")
复制代码
新建一个工作簿,后缀为xls
按alt+F11
把一下代码贴进去
Option Explicit
Sub 批量合并工作簿2()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String
Dim MyDir As String
MyDir = ThisWorkbook.path & ""
ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = MyDir
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Text = Null And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Wkb = Nothing
Set LastCell = Nothing
End Sub
复制代码
按f5运行
完成后再sheet1里面的A1单元格输入以下公式,下拉
B1单元格也用这个公式,但是公式的B5修改为B10即可
祝您成功!
=INDIRECT("'Sheet 24"&ROW(A26)&"'!B5")
复制代码