Sub RightGather()
'横向合并
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets(1).Select '新建一个汇总表
If Sheets.Count < 2 Then
Exit Sub
End If
Sheets.Add
Sheets(1).Name = "RightGather"
Cells.ColumnWidth = 10.25
Dim i, j, k, m, x, y, rw, col, L As Integer
L = 1
j = Sheets("RightGather").Cells(L + 1, Columns.Count).End(xlToLeft).Column + 2
For k = 2 To Sheets.Count
'j = Sheets("RightGather").Cells(2, Columns.Count).End(xlToLeft).Column + 2
If y > Columns.Count - j Then
L = L + 80
j = Sheets("RightGather").Cells(L + 1, Columns.Count).End(xlToLeft).Column + 2
End If
Sheets(k).Select
Cells.ColumnWidth = 10.25
x = 0
y = 0
For rw = 1 To 100 '工作表用到多少行,将100改成自己工作表用到的最大行号。或者Rows.Count(设置可能用到最大行,效率低)
For col = 1 To 50
VBA_Excel合并工作表进阶版
最新推荐文章于 2022-07-01 13:59:34 发布