標題: 複製多個工作表的內容 [打印本頁]

---

作者: lovegowan    時間: 2019-8-22 21:08     標題: 複製多個工作表的內容

大家好，這是第一次發文

小妹不才..目前正在學習中，最近需要處理大量的資料

需要將每日的工作表大量彙整，說明[attach]31173[/attach]如附檔

只想的到先用公式INDIRECT或者寫單一從各工作表複製貼上
但一項一項改很耗時，所以來請教....

謝謝各位不吝指教 :)

每日的工作表如下圖
[attach]31174[/attach]

需要將每日的項目以橫向的方式貼至下圖
[attach]31175[/attach]

非常感謝(鞠躬)

---

作者: lovegowan    時間: 2019-8-23 13:11

補充：目前只知道可以這麼寫
Sub 複製貼上()
Worksheets("1").Range("F30:N30").Copy _
Worksheets("sheet1").Range("B3")
Worksheets("1").Range("F31:N31").Copy _
Worksheets("sheet1").Range("K3")
Worksheets("1").Range("F32:N32").Copy _
Worksheets("sheet1").Range("T3")
Worksheets("1").Range("F33:N33").Copy _
Worksheets("sheet1").Range("AC3")
.
.
.
End Sub
以此類推，但因為工作表過多，不太可能把每個"1"改成"2"或"3"....
請教該用什麼迴圈來簡化重複的動作....感謝

---

作者: 准提部林    時間: 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

[attach]31177[/attach]


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

---

作者: 准提部林    時間: 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,)

右拉/下拉


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

---

作者: lovegowan    時間: 2019-8-24 18:46

回復 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

[attach]31179[/attach]


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

---

作者: lovegowan    時間: 2019-8-27 18:19

回復 6# 准提部林


    非常謝謝版主耐心的回復，我會再研究努力精進 :)

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)