VBAでマクロを組もうとしています。
作ろうとしているのは、フォルダを指定すると、そのフォルダの中に入っているワークブック全てのシートから特定の名前のシートだけ、別のブックにコピーされるというものです。
(例 1というフォルダの中にあ、い、うの3つのワークブックが入っているとすると、その3つのワークシートからAという名前のシートのみコピーされて、えという名前のワークブックにまとめられる。)

プログラムに関して初心者のため手探りで組んでみたのですが、「オブジェクト変数が…」というエラーが出てしまいます。

どこに原因があるのか教えていただけませんか。
コピペしたため改行など変かもしれません。
すみません。



Sub Sample()
Dim sFile As String
Dim sWB As Workbook, dWB As Workbook
Dim dSheetCount As Long
Dim sSheetCount As Long
Dim n As Integer
Dim i As Long

Const SOURCE_DIR As String = "C:\Users\A
Const DEST_FILE As String = "C:\Users\B.xls"

Dim sWork As Worksheet
Dim dWork As Worksheet

Dim tmp As Variant



Application.ScreenUpdating = False


sFile = Dir(SOURCE_DIR & "*.xls")
'SOURCE_DIR=「A」ファイルでその中に入ってるブックの名前を sFile とする

'フォルダ内にブックがなければ閉じる
If sFile = "" Then Exit Sub

'コピー先のブックを作成。dWBという名前のブックを加える。
Set dWB = Workbooks.Add

'dWBのシート数を取得。コピー先のシート数を表すときはdSheetCountを使う。
'コピー元のシート数はsSheetCountを使う。

dSheetCount = dWB.Worksheets.Count
sSheetCount = sWB.Worksheets.Count

Do
'コピー元のブックを開く
Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)


'コピー元のファイルに「りんご」という文字があるか確認する。
'もし文字があったらコピー先のブックにコピーする。

'コピー元のワークシート数の何番目なのか表記はnで表す。
'コピー元のワークシートのことをsWorkと表す。
'コピー先のワークシートのことをdWorkと表す。

Set sWork = sWB.Worksheets
Set dWork = dWB.Worksheets

For n = 1 To sWB.Worksheets.Count
If InStr("sWork(sSheetsCount).name", "りんご") <> 0 Then
sWork("りんご").Copy After:=dWB.Worksheets(dSheetCount)

'コピー先のシート名をコピー元のブックの名前に置き換える
'コピー先のシート数+1の数だけシートを確認して、
'「りんご」という文字があったものだけ置き換える。
For i = 1 To dSheetCount + 1
If InStr("dWork(i).name", "りんご") <> 0 Then

'置き換える名前はコピー元のブック名を_で区切った(1)にあたるものにする。
tmp = Split("sWb.Name", "_")
dWork(i).Name = tmp(1)
End If
Next
End If
Next



'コピー元ファイルを保存しないで閉じる。

'ワークブック"Book1.xls"を保存しないで閉じる
'Sub CloseWorkbook()
'Workbooks("Book1").Close SaveChanges:=False
'End Sub
sWB.Close SaveChanges:=False



'次のブックのファイル名を取得
sFile = Dir()
Loop While sFile <> ""

'コピー先ブック作成時にあったシートを削除
Application.DisplayAlerts = False
For i = dSheetCount To 1 Step -1
dWB.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

'コピー先ブックを保存して閉じる
dWB.SaveAs Filename:=DEST_FILE
dWB.Close

Application.ScreenUpdating = False
End Sub

質問者からの補足コメント

  • 回答ありがとうございます!

    sSheetcountのところに、Set sWB=ActiveWorkbook と追加したところ、無事にそこの部分を通ることができました!

    dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが、「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。

    dWBや他の部分についてはなにも書かなくていいということなのでしょうか?

      補足日時:2017/06/15 14:53

A 回答 (3件)

>>dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが、「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。




dWBはアウトプットするワークブック名であり既に
Set dWB = Workbooks.Add
とやってるから追加記述は要りません。
    • good
    • 0
この回答へのお礼

ありがとうございました。

ActiveWorkbookはそのような意味だったのですね。理解が足りませんでした。
ありがとうございます!

お礼日時:2017/06/15 19:55

>sSheetcountのところに、Set sWB=ActiveWorkbook と追加したところ、無事にそこの部分を通ることができました!



そりゃ通るだろうけど、間違ってます。

その後の
'コピー元のブックを開く
で初めてsWBは定義されるから、その後に移動しないと
いけません。

そもそも、変数の名前がどうしてそのアルファベットなのか
意識してますか?
Source (コピー元の)WorkBookと Destination(コピー先の)
WorkBookというつもりです、多分ね。

>dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが
何をいってるのかな?
Set dWB = Workbooks.Add ’ブックを新規作成してdWBにセットしてますよね。
dSheetCount = dWB.Worksheets.Count ’その新規ブックのシート数を代入してます。

てことで、ActiveWorkbookの出る幕は考えられないです。
でも、何を記述したんでしょうね?
「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。
が、気にはなります。
    • good
    • 0
この回答へのお礼

なるほど…まだまだ理解が足りていないのだと実感しました。
おそらくSetを別のところに書いてしまったためだと思われます。

削除し書き直したところ、なんとか動かすことができました。
ありがとうございました。

お礼日時:2017/06/15 19:54

全部は見てませんが


sSheetCount = sWB.Worksheets.Count ①

sWBに何も設定していないでいきなり使ってるから。

具体的なブック名をセットしないといけない。

sWBが今のアクティブブックの意味で使いたいなら
set sWB=ActiveWorkbookと言う文が①の前に必要。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング