求助EXCEL使用VBA批量打开一系列表格文件并复制里面的数据到另一个表格文件中

求助使用VBA批量打开一系列表格文件并复制里面的数据到另一个表格文件中以上是数据报表文件，效果及要求... 求助使用VBA批量打开一系列表格文件并复制里面的数据到另一个表格文件中

以上是数据报表文件，

效果及要求展开





 我来答

2个回答

#热议# 海关有哪些禁运商品？查到后怎么办？

百度网友ca64c0c
推荐于2017-12-16 · TA获得超过4667个赞

知道大有可为答主

回答量：2991

采纳率：61%

帮助的人：1478万

我也去答题访问个人页

关注

展开全部

Sub Copy_Data()
Dim wb As Workbook, rng As Range, sht As Worksheet
Dim sht_Name, theDate

sht_Name = "Sheet1" '假设所有报表文件中的数据都在 Sheet1
Set sht = ActiveSheet '保存当前工作表对象

fn = Dir(ThisWorkbook.Path & "\报表-*.xls", vbReadOnly) '打开第一个报表文件
Do While fn <> "" '开始循环
    Set wb = Workbooks.Open(fn) '以只读模式打开报表文件
    
    '取得报表文件中的日期字符串
    theDate = Mid(fn, InStr(fn, "\报表-") + 4, Len(fn) - InStr(fn, "\报表-") - 7)

    '将报表文件中的数据复制到当前工作表
    With wb.Worksheets(sht_Name)
        .Range(.Range("A2"), .Range("A1").End(xlToRight).End(xlDown)).Copy _
            Destination:=sht.Range("A65536").End(xlUp).Offset(1, 1)
    End With
    wb.Close (False) '关闭报表文件，不保存
    sht.Activate '激活当前工作表
    Range(Range("A65536").End(xlUp).Offset(1, 0), Range("B65536").End(xlUp).Offset(0, -1)) = DateValue(Format(theDate, "0000-00-00")) '在A列填充报表文件的日期信息
    fn = Dir
Loop '循环下一个报表文件
End Sub

更多追问追答

追问

我确定把这个工作表和报表是放在同一个文件夹的，运行宏的时候怎么出现这种错误

追答

请问，报表文件是 2007/2010 版的吗？那么后缀应该是 xlsx（我看提问中写的是 xls），那么代码要略作修改：

Sub Copy_Data()
Dim wb As Workbook, rng As Range, sht As Worksheet
Dim sht_Name, theDate

sht_Name = "Sheet1"
Set sht = ActiveSheet

fn = Dir(ThisWorkbook.Path & "\报表-*.xlsx", vbReadOnly)
Do While fn <> ""
    Set wb = Workbooks.Open(fn)
    theDate = Mid(fn, InStr(fn, "\报表-") + 4, Len(fn) - InStr(fn, "\报表-") - 8)
    With wb.Worksheets(sht_Name)
        .Range(.Range("A2"), .Range("A1").End(xlToRight).End(xlDown)).Copy _
            Destination:=sht.Range("A65536").End(xlUp).Offset(1, 1)
    End With
    wb.Close (False)
    sht.Activate
    Range(Range("A65536").End(xlUp).Offset(1, 0), Range("B65536").End(xlUp).Offset(0, -1)) = DateValue(Format(theDate, "0000-00-00"))
    fn = Dir
Loop
End Sub