| |
▼けい さん：
こんにちは。
ThisworkbookのあるシートのA5の値と同じシート名を
新規ブックにコピーしたいという事でしょうか？
変数名は変えてありますので
A5の値でNewBookをSaveしていますがそれでいいのですか？
Sub Test()
Dim strBook As String
Dim NewBook As Workbook
Dim sht As Worksheet
Dim strSht As String
Dim vSht As Variant
Dim i As Long
With ThisWorkbook '________ <=シート名は？
strBook = .Sheets("Sheet1").Range("A5").Value 'FullPathが入っているか？
'FullPathが入っている時検索シート用のData
If InStr(strBook, "\") > 0 Then
vSht = Split(strBook, "\")
strSht = Left(vSht(UBound(vSht)), InStrRev(vSht(UBound(vSht)), ".") - 1)
Else
If InStr(strBook, ".") > 0 Then
strSht = Left(strBook, InStrRev(strBook, ".") - 1)
Else
strSht = strBook
strBook = strBook & ".xls"
End If
End If
For Each sht In .Worksheets
If sht.Name Like strSht & "*" Then
i = i + 1
If i = 1 Then
sht.Copy
Set NewBook = ActiveWorkbook
Else
sht.Copy After:=NewBook.Worksheets(NewBook.Worksheets.Count)
End If
End If
Next
End With
NewBook.SaveAs strBook
End Sub
|
|
Ｙｕｋｉ
- 09/10/9(金) 11:20 -
