| |
▼琴葉 さん：
こんばんは。
>現在開かれているWorkbook(1) sheet(1)
>
> A B C D
>1 山田 1月1日
>2
>3
>4
>の時に、コマンドボタンクリックで新規ワークブックにて保存（とりあえずマイドキュメント）
>その際にブック名 山田 シート名 1月1日 で保存したいです。
>
>
>さらにWorkbook(2) sheet(1)
> A B C D
>1 山田 3月3日
>2
>3
>4
>ブック名 山田 シート名 3月3日 としたいのですが、すでに山田ブックがある場合、3月3日のしーとだけ追加することは出来ますでしょうか？
>よろしくお願いいたします。
このコピーしたいシートをアクティブにした状態で以下のコードを
実行して下さい。
'=============================================================
Sub copy_and_save()
Dim bknm As String
Dim shtnm As String
Dim bk As Workbook
With ActiveSheet
bknm = .Range("a1").Value
shtnm = Format(.Range("b1").Value, "m""月""d""日""")
On Error Resume Next
Set bk = Workbooks.Open("D:\My Documents\" & bknm & ".xls")
If Err.Number <> 0 Then
.Copy
With ActiveWorkbook.ActiveSheet
.Name = shtnm
.Parent.SaveAs "D:\My Documents\" & bknm & ".xls"
.Parent.Close
End With
Else
Err.Clear
.Copy after:=bk.Worksheets(bk.Worksheets.Count)
With bk
.Worksheets(.Worksheets.Count).Name = shtnm
If Err.Number <> 0 Then
MsgBox Err.Description
.Close False
Else
.Close True
End If
End With
End If
End With
End Sub
フォルダ名は、"D:\My Documents\"になっていますから、適当に
変更して下さい。
エラーチェックは、大雑把にしかしていませんよ！！
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
