請問如何將多張工作表整合成在總表， 工作表總表的Ａ欄是各工作表的名稱

leiru

請問如何將多張工作表整合成在總表，
工作表總表的Ａ欄是各工作表的名稱
謝謝

准提部林

牽涉格式及合併格, 用VBA吧~~
Sub 更新()
Dim Sht As Worksheet, R&, xE As Range, CL, N%
Call 清除
CL = Array(36, 35) '顏色
For Each Sht In Sheets
    If Sht.Name Like "#######-#*" = False Then GoTo 101 '判斷工作表名稱是否符合 "年月日-序號"
    R = Sht.Cells(Rows.Count, "D").End(xlUp).Row - 5
    If R <= 0 Then GoTo 101
    Set xE = Sheets("總表").Cells(Rows.Count, 1).End(xlUp)(2)
    Sht.Range("A6:G6").Resize(R - 1).Copy xE(1, 2)
    Sht.Range("A6").Resize(R - 1).Copy xE
    xE.Resize(R - 1) = Sht.Name
    N = 1 - N
    xE.Resize(R - 1, 8).Interior.ColorIndex = CL(N) '以顏色區分各工作表資料(若用不到可刪)
101: Next
End Sub

Sub 清除()
Sheets("總表").UsedRange.Offset(1, 0).EntireRow.Delete
End Sub

Xl0000070.rar (18.73 KB)

下載次數: 8

2019-10-6 10:49

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

leiru

回復 2# 准提部林


    謝謝回復
請問另一格式套這程式碼，要改的部份除了範圍及工作表名稱是否符合之外，是否還有其他地方（因對巨集不熟，只有改範圍，其他部份不知如何修改）


Sub 更新()
Dim Sht As Worksheet, R&, xE As Range, CL, N%
Call 清除
CL = Array(36, 35) '顏色
For Each Sht In Sheets
    If Sht.Name Like "#######-#*" = False Then GoTo 101 '判斷工作表名稱是否符合 "年月日-序號"
    R = Sht.Cells(Rows.Count, "D").End(xlUp).Row - 5
    If R <= 0 Then GoTo 101
    Set xE = Sheets("總表").Cells(Rows.Count, 1).End(xlUp)(2)
    Sht.Range("A5:N5").Resize(R - 1).Copy xE(1, 2)
    Sht.Range("A5").Resize(R - 1).Copy xE
    xE.Resize(R - 1) = Sht.Name
    N = 1 - N
    xE.Resize(R - 1, 8).Interior.ColorIndex = CL(N) '以顏色區分各工作表資料(若用不到可刪)
101: Next
End Sub

Sub 清除()
Sheets("總表").UsedRange.Offset(1, 0).EntireRow.Delete
End Sub