[[20200429093159]]　『指定したシートが無い場合次のループへ』（noa）　ページの最後に飛ぶ

『指定したシートが無い場合次のループへ』（noa）

初心者です。
いろいろな参考ページから切り貼りしてvbaを書いているのですが、
どこをどうすればよいかわからなくなっている状態です。
よろしくお願いいたします。

・do until 参照bookがなくなるまで
・"まとめbook"に
・"まとめbook"と同じフォルダの中にあるbookから（複数）
・"山田"と"合計"シートをコピーして貼り付け
・"合計"シートの名前を、"山田"のセル"A1"&"合計"のセル"B1"に書き換え
・"山田合計"になったシートのレイアウトなど変更し
・"山田"シートを消し
・参照bookを閉じる
・ループ

という順でvbaを作りました。
途中まではループするのですが、"合計"シートが無いbookにあたると
そこで止まってしまいます。

・"合計"シートが無かった場合、そのブックは飛ばして次のループに入る

を追加したいのですが、その方法がわかりません。

そもそも上記では "山田" と "合計" の２シートをコピペして、
作業後に "山田" を消すという奇妙な手順になっています。

参照bookのシート"山田"の"A1" & まとめbookの（コピペした）シート"合計"の"B1"

この合体でシート名を付ける手段がわからず、結局これだけのために
"山田"をコピペしてくる形になっています。

"合計"だけをコピペしてきて名前変更する、という作業ならエラーが
出てもresume nextでループできていました。
２シートをコピーしてくることで、その後の作業が（count+2)になり、
するとエラーをresume nextで処理できなくなり・・・と、このあたり
から初心者の限界で、何をどう直せばよいのかわかりません。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 やってることの具体がイメージできないので、現状のコードを貼り付けてください。
 そしたら、コメントつくと思います。
（´・ω・`） 2020/04/29(水) 10:37

（コピペできないので書きます。スペルミス等スルーしてください）

Dim mypath as stringm fN as string,wS as Worksheet,count as long

my Path=thisworkbook.path &"\"
fN=dir(myPath & "*.xlsx")

Do until fN=""
Workbooks.open(myPath & fN)
Set workbook=ActiveWorkbook
count=count+1
Worksheets(aray("山田","合計")).copy after:=thisworkbook.worksheets(count)
wS.name="テスト"& sheets("山田".cells(1,"A") & sheets("合計").cells(1,"B")
wS.
workbook.close
sheets("山田").delete

fN=Dir()
Loop

（noa） 2020/04/29(水) 11:19

(訂正)
stringm →　string,
workbook.close 前の　wS.のあとにはレイアウト変更等入ってます
（noa） 2020/04/29(水) 11:25

手打ちしたとのことなので、しょうがないのかもしれませんが、

 (1)Sub～End Subまでが一つのプロシージャなので、提示したほうが
    お互いに誤解がないように思います。
 (2)こだわりがなければインデントを付けることとをおすすめします。
    （実際にはついてるのかもしれませんが・・）

    Sub 名無しのまくろ()
        Dim ブック名 As StdFont
        Dim srcWB As Workbook
        Dim tmpSH  As Worksheet
        Dim MyWB As Workbook

        Set MyWB = ThisWorkbook

        ブック名 = Dir(ThisWorkbook.Path & "\*.xls?")
        Do Until ブック名 = ""
            Stop '←ブレークポイントの代わり

            Set srcWB = Workbooks.Open(ThisWorkbook.Path & "\" & ブック名)

            '▼一時的にエラーを無視して進める
            On Error Resume Next
            Set tmpSH = srcWB.Worksheets("合計")
            On Error GoTo 0

            '▼エラーが発生した（"合計"シートが無い）場合、「tmpSH」は初期値の「Nothing」のままになっている
            If Not tmpSH Is Nothing Then

                '▼自ブックの"末尾"に「tmpSH」をコピー挿入する
                tmpSH.Copy after:=MyWB.Worksheets(MyWB.Worksheets.Count)

                '▼末尾に挿入されたシートを操作する
                With MyWB.Worksheets(MyWB.Worksheets.Count)
                    .Name = srcWB.Worksheets("山田").Range("A1").Value & _
                            .Range("B1").Value

                    'レイアウト変更等
                End With
            End If

            '▼「合計」シートの有無にかかわらず「tmpSH」を初期化してブックを閉じる
            Set tmpSH = Nothing
            srcWB.Close False

            '次のブックを探す
            ブック名 = Dir()
        Loop 
    End Sub

（もこな２） 2020/04/29(水) 12:23

↑の訂正

 誤　Dim ブック名 As StdFont
 正　Dim ブック名 As String

なお、書き忘れましたがコンパイルエラーにならないことしかチェックしてないので、他にもミスがあるかもです。

（もこな２） 2020/04/29(水) 12:28

もこな２様

ありがとうございます。無事希望の形で動いています。
まだよくわかりませんが、今から中身見てみます。

If Not tmpSH Is Nothing Then

With MyWB.Worksheets(MyWB.Worksheets.Count)

のあたりが、ああそうか、と思っています。
じっくり読みます。ありがとうございます。
取り急ぎお礼まで。
（noa） 2020/04/29(水) 22:17

追加で質問させてください。

上記では同じフォルダの中に入れたExcelすべて参照、という扱いでしたが、
作業していくうちそれでは不都合が出てきました。

同じフォルダの中の、特定のサブフォルダ（たとえば「集計」という名前）内
のファイルをすべて参照する、という形にするには、どうすればいいでしょうか。

・現在のフォルダは移動やコピペする可能性がある
・今後サブフォルダ増やす可能性がある（サブフォルダのさらに下位にはフォルダ作成しない）

（wo） 2020/04/30(木) 16:38

↓に移動
[[20200501094010]]　『特定のサブフォルダを参照する』（noa）

（もこな２） 2020/05/01(金) 10:18

コメント返信：

[ 一覧(最新更新順) ]

[[20200429093159]] 『指定したシートが無い場合次のループへ』（noa） ページの最後に飛ぶ

[[20200429093159]]　『指定したシートが無い場合次のループへ』（noa）　ページの最後に飛ぶ