返回列表 上一主題 發帖

複製多個工作表的內容

複製多個工作表的內容

大家好,這是第一次發文

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

需要將每日的工作表大量彙整,說明 多個工作表複製.rar (13.58 KB) 如附檔

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

謝謝各位不吝指教 :)

每日的工作表如下圖
1.png
2019-8-22 21:07


需要將每日的項目以橫向的方式貼至下圖
2.png
2019-8-22 21:07


非常感謝(鞠躬)

補充:目前只知道可以這麼寫
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"....
請教該用什麼迴圈來簡化重複的動作....感謝

TOP

各個分表都是固定格式,
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)


===================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

公式法
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,)

右拉/下拉


=============================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 3# 准提部林


    非常感謝版主的回覆

因為有點超過我的理解範圍

不知道可否請版主稍微講解

如果日後欄位有增加或者儲存個指定範圍有變動

我可以自行做修改,再次感謝版主的指教

TOP

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


=================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 6# 准提部林


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

TOP

        靜思自在 : 受人點水之恩,須當湧泉以報。
返回列表 上一主題