- 帖子
- 2842
- 主題
- 10
- 精華
- 0
- 積分
- 2898
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-4-28
|
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 |
|