返回列表 上一主題 發帖

[發問] 請益大大.多個活頁資料另存新檔

cyfchuang

帖子
8 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2016-12-8 
最後登錄
2025-9-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2025-4-23 13:44 | 只看該作者

[發問] 請益大大.多個活頁資料另存新檔

本帖最後由 cyfchuang 於 2025-4-23 13:50 編輯


第一個活頁，有三個批號


第一個活頁，保留第一個批號，另存新檔，檔名為批號


第一個活頁，保留第二個批號，另存新檔，檔名為批號


第一個活頁，保留第三個批號，另存新檔，檔名為批號
共三個活頁，六個批號，因此要另存資料為六個檔案
視狀況會有多個活頁與批號需要分開存檔
請益大大們，怎麼做出分割這些資料

TTS.zip (13.83 KB)

收藏 分享

catbears

帖子
18 
主題
0 
精華
0 
積分
68 
點名
56  
作業系統
Windows 10 
軟體版本
Office 365 
閱讀權限
20 
註冊時間
2022-4-20 
最後登錄
2025-4-29 
2#
發表於 2025-4-25 16:21 | 只看該作者
給你一些寫的思路

1.左邊制式化部分，可以製作一張表專門跑新頁面時複製貼上，當基底新的EXCEL用
2.用LOOP 的方式去把一欄一攔複製貼上後儲存新檔

由這部分開始去發展，如有遇到什麼寫的問題可以再行討論

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-10-18 
3#
發表於 2025-4-26 13:40 | 只看該作者
Sub 拆分另存()
Dim xS As Worksheet, xA As Range, Cn&, j&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xS In Sheets
    Set xA = xS.Range(xS.[a1], xS.UsedRange).Offset(8)
    Cn = xA.Columns.Count
    For j = 5 To Cn
        If xA.Cells(1, j) <> "Batch  No" Then GoTo j01
        If xA.Cells(2, j) = "" Then GoTo j01
        xS.Copy
        With ActiveWorkbook
             xA.Columns(j).Copy .Sheets(1).[e9]
             .Sheets(1).[f9].Resize(xA.Rows.Count, Cn).ClearContents
             .SaveAs Filename:=ThisWorkbook.Path & "\" & xA.Cells(2, j) & ".xls", CreateBackup:=False
             .Close 0
        End With
j01: Next j
Next
End Sub

TOP

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題