Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


55284 / 76738 ←次へ | 前へ→

【26232】Re:コマンドボタンクリックで保存
発言  ichinose  - 05/6/28(火) 18:09 -

引用なし
パスワード
   ▼琴葉 さん:
こんばんは。

>現在開かれている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\"になっていますから、適当に
変更して下さい。
エラーチェックは、大雑把にしかしていませんよ!!
0 hits

【26229】コマンドボタンクリックで保存 琴葉 05/6/28(火) 16:45 質問
【26232】Re:コマンドボタンクリックで保存 ichinose 05/6/28(火) 18:09 発言
【26234】Re:コマンドボタンクリックで保存 琴葉 05/6/29(水) 9:43 お礼
【26244】Re:コマンドボタンクリックで保存 琴葉 05/6/29(水) 13:50 質問
【26245】Re:コマンドボタンクリックで保存 琴葉 05/6/29(水) 13:56 お礼
【26246】Re:コマンドボタンクリックで保存 琴葉 05/6/29(水) 14:04 お礼

55284 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free