我發現這段代碼非常好用，但我希望有人能指導我如何移動那些沒有命名為valid、control和data的表單。這三個被命名的表單是我的常量，不需要移動它們。
Option Explicit>
Sub MoveSheets()
Dim sPath As String
Dim sAddress As String
Dim wbCur As Workbook
Dim wsCur As 作業表
'--存盤此作業簿的路徑 --
sPath = ThisWorkbook.Path & Application.PathSeparator
'-- 回圈使用作業表 --
For Each wsCur In ThisWorkbook.Worksheets
On Error Resume Next
Set wbCur = Nothing
'-- 添加一個新的作業簿 --
Set wbCur = Workbooks.Add
On Error GoTo 0
If wbCur Is Nothing Then
'--報告任何錯誤 --
MsgBox prompt:=Err.Description
Else
'-- 重命名新作業簿的作業表1 --
wbCur.Sheet(1).Name = wsCur.Name
'--獲得輸入資料的范圍地址 --
sAddress = wsCur.UsedRange.Address
'-- 復制 & 粘貼資料 --
wsCur.UsedRange.Copy Destination:=wbCur.Sheet(1).Range(sAddress)
'--保存新的作業簿，檔案名=當前作業表名稱--。
wbCur.Close savechanges:=True, Filename:=sPath & wsCur.Name & " .xlsx"
End If
Next wsCur
結束 子
uj5u.com熱心網友回復：
請測驗下一段代碼：
Sub MoveSheets()
Dim sPath As String, sAddress As String, wsCur As Worksheet
Dim arrNoMoveSh, mtchSh
arrNoMoveSh = Split("valid,control,data", "," ) '創建一個不被移動的表單名稱的陣列。
'--存盤這個作業簿的路徑 --
sPath = ThisWorkbook.path & Application.PathSeparator
'-- 回圈瀏覽作業表 --
For Each wsCur In ThisWorkbook.Worksheets
mtchSh = Application.match(wsCur.Name, arrNoMoveSh, 0)
If IsError(mtchSh) Then '在陣列中沒有找到作業表名稱。
wsCur.Copy '為要復制的作業表創建一個新的作業簿!!!
ActiveWorkbook.Close savechanges:=True, FileName:=sPath & wsCur.Name & " .xlsx"
End If
Next wsCur
結束 子
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/324159.html
標籤：