继续发合并统一格式报表

ffllyyssnn

Sub 合并数据() Range("A2", [G2].End(xlDown)).ClearContents Dim fn, rng, rng1, rng3 As Range, n, i, X X = ActiveSheet.Name fn = Dir(ThisWorkbook.Path & "\" & X & "\*.xls") Do n = n + 1 Workbooks.Open (ThisWorkbook.Path & "\" & X & "\" & fn) Set rng = Sheets(1).Range("A1", [G1].End(xlDown)) Set rng1 = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(1, 1) rng.Copy rng1 ActiveWorkbook.Close 0 fn = Dir Loop Until fn = "" For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step 1   If Cells(i, 1) = "订单号" Then Rows(i & ":" & i).Delete Next MsgBox "共合并" & n & "份表格！" End Sub 老师们帮忙看看附件是什么原因合并出来数据不对 我要合并的分表格都是统一格式。

f8b1987

*.xls*"
或者
*xlsx

ffllyyssnn

合并内容少了有老师能改吗

ykcbf1100

你试一下吧，我这里是没问题的。

ffllyyssnn

ykcbf1100 发表于 2021-12-8 10:22
你试一下吧，我这里是没问题的。

谢谢。我自己也改好了。把rng1中End(xlUp)(1, 1)变成End(xlUp)(2, 1)和For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step 1 变成For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1