Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6750 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【43355】シートがあればコピーする方法 成田 06/10/11(水) 12:11 質問[未読]
【43356】Re:シートがあればコピーする方法 ハチ 06/10/11(水) 12:40 回答[未読]
【43377】Re:シートがあればコピーする方法 成田 06/10/12(木) 11:57 お礼[未読]
【43378】Re:シートがあればコピーする方法 成田 06/10/12(木) 11:59 発言[未読]
【43355】シートがあればコピーする方法
質問  成田  - 06/10/11(水) 12:11 -
引用なし
パスワード
   初めまして。成田と申します。

現在、Excel の VBA を使って、
Aというシートを新規のブックにコピー
Bという名前のシートがあれば、Aをコピーしたブックにコピー
Cという名前のシートがあれば、Aをコピーしたブックにコピー
D（以下同上）
最後に、新規のブックをある場所に保存。
という動作をさせたいと考えています。

いろいろと調べてみて、次のようなVBAを組めばよいことは分かりました。

　　Dim WSName As Worksheet
　　Sheets("A").Select
　　Sheets("A").Copy
　　Set WSName = Worksheets("B")
　　Workbooks(myfile).Activate
　　If Not WSName Is Nothing Then
　　Sheets(WSName).Select
　　Sheets(WSName).Copy before:=Workbooks("Book1").Sheets(1)
　　End If
　　Set WSName = Worksheets("C")
　　Workbooks(myfile).Activate
　　If Not WSName Is Nothing Then
　　Sheets(WSName).Select
　　Sheets(WSName).Copy before:=Workbooks("Book1").Sheets(1)
　　End If
　　Set WSName = Worksheets("D")
　　Workbooks(myfile).Activate
　　If Not WSName Is Nothing Then
　　Sheets(WSName).Select
　　Sheets(WSName).Copy before:=Workbooks("Book1").Sheets(1)
　　End If

　　Workbooks("book1").Activate
　　Sheets("A").Activate
　　ChDir "\\192.168.1.1\share"
　　　　ActiveWorkbook.SaveAs Filename:="filename", _
　　　　　　FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
　　　　　　ReadOnlyRecommended:=False, CreateBackup:=False
　　ActiveWorkbook.Save

しかしながら、B というシートが存在しない場合などには、「インデックスが有効範囲にありません」というメッセージがでて失敗してしまいます。
そのため、On Error Resume Next を入れたところ、Book1 が作られなくなってしまいました。（何かおかしいと思うのですけれども）

必ず存在する１つのシートを新しいブックにコピーし、その後はシートが存在すれば同じブックにコピーする方法について、ご教示いただけませんでしょうか。
また、できれば、On Error Resume Next を使用しない方法をとりたいと考えています。（ファイルの保存に失敗した場合などに困るので・・）

お手数をおかけいたしますが、よろしくお願いします。
【43356】Re:シートがあればコピーする方法
回答  ハチ  - 06/10/11(水) 12:40 -
引用なし
パスワード
   ▼成田 さん：
>必ず存在する１つのシートを新しいブックにコピーし、その後はシートが存在すれば同じブックにコピーする方法について、ご教示いただけませんでしょうか。
>また、できれば、On Error Resume Next を使用しない方法をとりたいと考えています。（ファイルの保存に失敗した場合などに困るので・・）
>
>お手数をおかけいたしますが、よろしくお願いします。

新しいBookをオブジェクトとしてつかんでおいて、
元のBookのWorkSheetをループさせて名前を判定すれば、
On Error Resume Nextは使わなくて良いと思います。
テストしてませんので、間違っていたらすいません。

変数：myfileはどこから出てきたのでしょうか？？

Sub Test()
　　Dim Wb As Workbook
　　Dim Ws As Worksheet

　　Set Wb = Workbooks.Add
　　For Each Ws In ThisWorkbook.Worksheets　'マクロをどこに置くかで変更必要。
　　　　Select Case Ws.Name
　　　　　　'ここにコピーしたいSheet名をCase xxで追加
　　　　　　Case "A": Ws.Copy Before:=Wb.Worksheets(1)
　　　　　　Case "B": Ws.Copy Before:=Wb.Worksheets(1)
　　　　End Select
　　Next Ws
　　Wb.SaveAs '・・・保存するところ
　　Set Wb = Nothing
　　
End Sub
【43377】Re:シートがあればコピーする方法
お礼  成田  - 06/10/12(木) 11:57 -
引用なし
パスワード
   ▼ハチ さん：

ご教示頂き、ありがとうございました。
全く問題なく、私のやりたいことができました。
（ついでに応用もきかせて、シートがあったら削除する、というものも作ってみました。）

本当にありがとうございました！

>▼成田 さん：
>>必ず存在する１つのシートを新しいブックにコピーし、その後はシートが存在すれば同じブックにコピーする方法について、ご教示いただけませんでしょうか。
>>また、できれば、On Error Resume Next を使用しない方法をとりたいと考えています。（ファイルの保存に失敗した場合などに困るので・・）
>>
>>お手数をおかけいたしますが、よろしくお願いします。
>
>新しいBookをオブジェクトとしてつかんでおいて、
>元のBookのWorkSheetをループさせて名前を判定すれば、
>On Error Resume Nextは使わなくて良いと思います。
>テストしてませんので、間違っていたらすいません。
>
>変数：myfileはどこから出てきたのでしょうか？？
>
>Sub Test()
>　　Dim Wb As Workbook
>　　Dim Ws As Worksheet
>
>　　Set Wb = Workbooks.Add
>　　For Each Ws In ThisWorkbook.Worksheets　'マクロをどこに置くかで変更必要。
>　　　　Select Case Ws.Name
>　　　　　　'ここにコピーしたいSheet名をCase xxで追加
>　　　　　　Case "A": Ws.Copy Before:=Wb.Worksheets(1)
>　　　　　　Case "B": Ws.Copy Before:=Wb.Worksheets(1)
>　　　　End Select
>　　Next Ws
>　　Wb.SaveAs '・・・保存するところ
>　　Set Wb = Nothing
>　　
>End Sub
【43378】Re:シートがあればコピーする方法
発言  成田  - 06/10/12(木) 11:59 -
引用なし
パスワード
   すみません。追記です。

Myfile は、thisworkbook.name を保持していて、
そのブックをSelect しようとしたものです。
既に別の方法を提示いただいていますので、
忘れていただいて問題ありません！

よろしくお願いします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6750 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free