返回列表 上一主題 發帖

複製多個工作表的內容

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2019-8-24 10:00 | 顯示全部帖子
各個分表都是固定格式,
Sub 載入()
Dim Arr, A, Sc%, N%, i&, j&
ActiveSheet.UsedRange.Offset(3, 0).EntireRow.Delete
Sc = Sheets.Count - 1
ReDim Arr(1 To Sc, 1 To 181)
For i = 2 To Sheets.Count
    Arr(i - 1, 1) = Sheets(i).Name
    For j = 1 To 180
        Arr(i - 1, j + 1) = Sheets(i).[D4:L23].Item(j)
    Next j
Next
[C4].Resize(Sc, 181) = Arr
End Sub

Xl0000498.rar (16.52 KB)


===================================

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2019-8-24 10:15 | 顯示全部帖子
公式法
C欄輸入工作表名稱
D4:
=INDEX(INDIRECT("'"&$C4&"'!D4:L23"),COUNTA($D$2:D$2),D$3)
或
=INDEX(INDIRECT("'"&$C4&"'!D4:L23"),INT(COLUMN(I1)/9),D$3)
或
=VLOOKUP(LOOKUP("龥",$D$2:D$2),INDIRECT("'"&$C4&"'!B:L"),D$3+2,)

右拉/下拉


=============================

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
3#
發表於 2019-8-25 11:17 | 顯示全部帖子
回復 5# lovegowan

用儲存格對照法吧!  速度較慢:
Sub 載入()
Dim xA As Range, xArea As Range, i, j&
Sheets("主表").UsedRange.Offset(3, 0).EntireRow.Delete
Set xA = [主表!C3]  '初始寫入定位格
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
    Set xA = xA(2, 1)  '寫入定位格向下移一格
    xA = "工作表--" & Sheets(i).Name '寫入工作表名稱
    Set xArea = Sheets(i).[D4:L23]  '定位各分表資料區域
    For j = 1 To 20 '由上往下抓[D4:L23]整列, 再由左往右寫入主表
        xA(1, (j - 1) * 9 + 2).Resize(1, 9) = xArea.Rows(j).Value
    Next j
Next
Range([主表!C4], xA(1, 181)).Borders.LineStyle = 1 '加入框線
End Sub

Xl0000498-1.rar (17.2 KB)


=================================

TOP

        靜思自在 : 每天無所事事，是人生的消費者，積極、有用才是人生的創造者。
返回列表 上一主題