求助，同一文件夹内按工作簿名称横向合并

chenjian8579

在论坛之中找到版主之前做的一个宏已经很好用了，不过之前那个是默认打开的工作簿名称进行横向合并，已经在附件里，如果哪位大神能稍微修改下按照工作簿名横向合并我就感激不尽了

lsc900707

朱荣兴 发表于 2017-6-25 05:45
说实话，看了好几遍，还是不行明白你的意思

估计就是每个表都要横向拼接起来！

chenjian8579

是的，同工作簿名称的表进行横向拼接，附件里有个半成品的宏，是默认打开的报表进行拼接，希望里面加个参数按照工作簿名称进行横向拼接

chenjian8579

Sub g()
mypath = ActiveWorkbook.Path & "\"
myname = "损益表"
myfile = Dir(mypath & "*.xls")
m = 2
n = 1
Do Until Len(myfile) = 0
    If myfile <> myname Then
        Workbooks.Open Filename:=mypath & myfile
        wbname = Left(myfile, InStr(myfile, ".") - 1)
        lastcol = Cells(2, Columns.Count).End(xlToLeft).Column
        lastrow = Cells(Rows.Count, 1).End(3).Row
        arr = Range(Cells(2, 1), Cells(lastrow, lastcol))
        ActiveWorkbook.Close savechanges:=flase
    End If
    Cells(2, n).Resize(UBound(arr), UBound(arr, 2)) = arr
    ncol = Cells(2, Columns.Count).End(xlToLeft).Column
    Range(Cells(1, m), Cells(1, ncol)).Merge
    Cells(1, m).HorizontalAlignment = xlCenter
    Cells(1, m) = wbname
    m = m + UBound(arr, 2)
    n = n + UBound(arr, 2)
    Erase arr
    myfile = Dir
Loop
ActiveSheet.UsedRange.Borders.LineStyle = 7
For Each Rng In Range(Cells(2, 1), Cells(2, Columns.Count).End(xlToLeft))
    If Rng <> "" Then Rng.Value = Application.Text(Rng.Value, "h:mm:ss")
Next Rng
End Sub
这是蓝老师之前作出的宏，想加个参数，比如：合并损益表的时候就只横向拼接损益表，损益表工作簿名称是一样的

chenjian8579

为啥需要审核？

jjmysjg

楼主，这个帖子有结果了吗