Excel VBA質問箱 IV

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

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


10022 / 13644 ツリー ←次へ | 前へ→

【24048】ブック名をアクティブシート名の1つと同じにするには? tarny 05/4/11(月) 1:16 質問[未読]
【24049】Re:ブック名をアクティブシート名の1つと... ちゃっぴ 05/4/11(月) 1:32 回答[未読]
【24051】Re:ブック名をアクティブシート名の1つと... tarny 05/4/11(月) 3:04 質問[未読]
【24098】Re:ブック名をアクティブシート名の1つと... Jaka 05/4/12(火) 13:02 発言[未読]
【24118】Re:ブック名をアクティブシート名の1つと... kazu 05/4/12(火) 15:14 発言[未読]
【24192】Re:ブック名をアクティブシート名の1つと... tarny 05/4/15(金) 0:36 お礼[未読]

【24048】ブック名をアクティブシート名の1つと同...
質問  tarny  - 05/4/11(月) 1:16 -

引用なし
パスワード
   すみません。VBA初心者です。
1つのブックにワークシートが複数存在し、シート名は関連付けられた名前で並んでいます。(ex.ABC/ABC明細/DEF/DEF明細/GHI/GHI明細・・・・)
2つの関連づけられたシート(ex.ABC/ABC明細)をアクティブにして、左側のシートの名前(ABC)をそのまま新しいブック名にして保存したいのですが、どのようなコードにすればよいのでしょう?

以下の例だと、シートが1つの場合は問題ないのですが、複数シートはコピーされません。どなたかご助言お願いいたします。<(_ _)>
↓↓↓

Sub 新規ブック作成()

Dim ブック名
  
ブック名 = ActiveSheet.Name
  ActiveSheet.Copy
 ActiveWorkbook.SaveAs (ブック名 & ".xls")
  ActiveWorkbook.Close
  
End Sub

【24049】Re:ブック名をアクティブシート名の1つ...
回答  ちゃっぴ  - 05/4/11(月) 1:32 -

引用なし
パスワード
   > ActiveSheet.Copy

現在ActiveなSheetのみCopyすととなっているので当然でしょう?
SheetをすべてCopyするようにしてやればいいでしょう。

Hint:
Sheets Collection に対して Copy Methodは有効です。

【24051】Re:ブック名をアクティブシート名の1つ...
質問  tarny  - 05/4/11(月) 3:04 -

引用なし
パスワード
   ちゃっぴ さん、早速の返信ありがとうございました。

すみません。とぼけた質問をしておりました。
シートのアクティブとは一番手前のシートのみ取得されるのでしたね。

本当に操作したい内容は、ファイルを開いた状態で、複数シートを選択し、選択した一番左側のシート名を新しいブック名で保存する、という作業を繰り返し実行したいのです。(ループできれば理想なのですが、関連付けシートが2枚だったり3枚だったりするので)

SheetをすべてCopyという事は全シートコピーなのですよね?

【24098】Re:ブック名をアクティブシート名の1つ...
発言  Jaka  - 05/4/12(火) 13:02 -

引用なし
パスワード
   こんにちは。
よく解ってませんから、適当に直してください。

Sub nnmm()
  For i = 1 To ThisWorkbook.Worksheets.Count
    Shnm = ThisWorkbook.Worksheets(i)
    ThisWorkbook.Worksheets(i).Copy
    保存ファイルフルパス = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Shnm & ".xls"
    ActiveWorkbook.SaveAs FileName:=保存ファイルフルパス
    DoEvents
    Workbooks(Shnm & ".xls").Close
  Next
End Sub

Sub nnmm2()
  Shnm = ActiveWindow.SelectedSheets(1).Name
  ActiveWindow.SelectedSheets(1).Copy
  保存ファイルフルパス = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Shnm & ".xls"
  ActiveWorkbook.SaveAs FileName:=保存ファイルフルパス
  DoEvents
  Workbooks(Shnm & ".xls").Close
End Sub

【24118】Re:ブック名をアクティブシート名の1つ...
発言  kazu  - 05/4/12(火) 15:14 -

引用なし
パスワード
   ▼tarny さん:

こんな感じなのかな・・・。

Sub Smpl()
  Set Buf = ThisWorkbook.Sheets
  Cnt = Buf.Count
  ReDim CpFlg(1 To Cnt)
  For I = 1 To Cnt
    CpFlg(I) = False
  Next
  For I = 1 To Buf.Count
    Set ActBook = Nothing
    Tmp = Buf(I).Name
    For J = 1 To Buf.Count
      If Buf(J).Name Like "*" & Tmp & "*" And Not CpFlg(J) Then
        If ActBook Is Nothing Then
          Buf(J).Copy
          Set ActBook = ActiveWorkbook
          CpFlg(J) = True
        Else
          Buf(J).Copy , Sheets(ActBook.Sheets.Count)
          CpFlg(J) = True
        End If
      End If
    Next
    If Not ActBook Is Nothing Then
      Pth = ThisWorkbook.Path & "\" & Buf(I).Name & ".XLS"
      If Dir(Pth) <> "" Then
        If MsgBox("指定された場所にすでに同一ファイル名が存在します。【" & Buf(I).Name & ".XLS】" & vbCrLf & _
            "上書きしますか") = vbYes Then
          Kill Pth
          ActBook.SaveAs Pth
          ActBook.Close
        End If
      Else
        ActBook.SaveAs Pth
        ActBook.Close
      End If
    End If
  Next
  
End Sub

【24192】Re:ブック名をアクティブシート名の1つ...
お礼  tarny  - 05/4/15(金) 0:36 -

引用なし
パスワード
   ちゃっぴさん、Jakaさん、kazu さん
ご助言ありがとうございました。

ループのところはもう一歩なのですが、当初やりたかった事はJakaさんのものを
少しカスタマイズする事で実現できました。
便利なコードがあるもんですね。勉強になりました。<(_ _)>

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