| |
▼ichinose さん：
>▼琴葉 さん：
>こんばんは。
>
>>現在開かれている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\"になっていますから、適当に
>変更して下さい。
>エラーチェックは、大雑把にしかしていませんよ！！
ichinoseさん、ありがとうございます。
ほかの仕事が入ってしまったため、後ほど作業してみます。
|
|
琴葉
- 05/6/29(水) 9:43 -
