[已解决]关于多工作簿中工作表合并问题

czl103

各位大虾，请查看附件中“合并”表格，运行VBA程序之后合并了三个工作表，只是前两个都少了一行（最后一行），请大虾帮忙找出为啥少了一行，并修正代码加上这一行，感激。

Sub 合并文件夹下工作表到一个工作簿()
    Dim p$, f$
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Cells.Clear
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsx")
    Do While f <> ""
        With Workbooks.Open(p & f)
        .Sheets(1).Range("a1").CurrentRegion.Copy ThisWorkbook.Sheets(1).Range("a1048576").End(xlUp).Offset(1, 0)
        .Close
        End With
        f = Dir
    Loop
End Sub

最佳答案

月排行榜 / 总排行榜

爱疯

2016-3-2 21:09

Wk.Sheets(1).Range(Wk.Sheets(1).Cells(1, 1), Wk.Sheets(1).Cells(Wk.Sheets(1).UsedRange.Rows.Count + 1, Wk.Sheets(1).UsedRange.Columns.Count)).Copy ThisWorkbook.Sheets("合并").Cells(s + 3, 1)


注意，红色处+1就可以了

跳转到最佳答案楼层

爱疯

1）运行VBA程序之后，没有给出1楼说的VBA程序？
2）为什么合并后，表1和表2要少第4行？

czl103

爱疯 发表于 2016-3-2 17:12
1）运行VBA程序之后，没有给出1楼说的VBA程序？  
不好意思，这次应该有了
2）为什么合并后，表1和表2要少第4行？

不是要少第4行，正因为少了第4行，才来找大虾帮忙改正代码。

爱疯

Sub test()
    Dim p$, f$
    Application.ScreenUpdating = False
    Cells.Clear
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsx")
    Do While f <> ""
        With Workbooks.Open(p & f)
        .Sheets(1).Range("a1").CurrentRegion.Copy ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Offset(1, 0)
        .Close
        End With
        f = Dir
    Loop
End Sub
多工作表合并2.rar (49.73 KB, 下载次数: 16)

2016-3-2 18:00 上传

点击文件名下载附件


简单处理了，看可以吗

czl103

爱疯 发表于 2016-3-2 18:00
Sub test()
    Dim p$, f$
    Application.ScreenUpdating = False

没问题，这么简单的代码就可以了？高手。。。

czl103

爱疯 发表于 2016-3-2 18:00
Sub test()
    Dim p$, f$
    Application.ScreenUpdating = False

有一个不情之请，能帮忙检查原有代码的错误吗？为啥少一行？

爱疯

Wk.Sheets(1).Range(Wk.Sheets(1).Cells(1, 1), Wk.Sheets(1).Cells(Wk.Sheets(1).UsedRange.Rows.Count + 1, Wk.Sheets(1).UsedRange.Columns.Count)).Copy ThisWorkbook.Sheets("合并").Cells(s + 3, 1)


注意，红色处+1就可以了

czl103

爱疯 发表于 2016-3-2 21:09
Wk.Sheets(1).Range(Wk.Sheets(1).Cells(1, 1), Wk.Sheets(1).Cells(Wk.Sheets(1).UsedRange.Rows.Count +  ...

可以，多谢了，大虾。。。