返回列表 上一主題 發帖

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

leiru

帖子
334 
主題
139 
精華
0 
積分
621 
點名
0  
作業系統
WINDOWSXP 
軟體版本
OFFICE2003 
閱讀權限
50 
性別
女 
來自
台北縣 
註冊時間
2010-8-5 
最後登錄
2022-11-3 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-10-5 16:00 | 只看該作者

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

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

多張工作表整合在總表.zip (17.64 KB)

收藏 分享
joyce

leiru

帖子
334 
主題
139 
精華
0 
積分
621 
點名
0  
作業系統
WINDOWSXP 
軟體版本
OFFICE2003 
閱讀權限
50 
性別
女 
來自
台北縣 
註冊時間
2010-8-5 
最後登錄
2022-11-3 
3#
發表於 2019-10-7 17:22 | 只看該作者
回復 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

另一形式多表合併總表.zip (22 Bytes)

joyce

TOP

准提部林

帖子
2839 
主題
10 
精華
0 
積分
2895 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-12-27 
2#
發表於 2019-10-6 10:49 | 只看該作者
牽涉格式及合併格, 用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)

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

TOP

        靜思自在 : 君子立恆志，小人恆立志。
返回列表 上一主題