VBA のコードについて

質問

すみません、以前にも同じようなご質問をさせて頂いたのですが、どうしても以下のマクロがうまく機能しません。
新しいブックは作成されるのですが、End If以降の検索結果が反映（コビー）されません。
コードに問題があるかアドバイス頂けますと幸いです。
どうぞ宜しくお願いいたします。

Sub sort()

Dim i As Long
Dim grp As String
Dim newBookName As String
Dim newBookPath As String
Dim newBook As Workbook

For i = 2 To 4

LOB = Workbooks("test").Worksheets("grpリスト").Cells(i, 2)
newBookName = Workbooks("test").Worksheets("grpリスト").Cells(i, 2) & ".xlsx"

newBookPath = ThisWorkbook.Path & "\" & newBookName

'指定したパスにファイルが作成済でないかを確認。
If Dir(newBookPath) = "" Then
'新しいファイルを作成
Set newBook = Workbooks.Add

'新しいファイルをVBAを実行したファイルと同じフォルダ保存
newBook.SaveAs newBookPath

Else
'既に同名のファイルが存在する場合はメッセージを表示
MsgBox "既に" & newBookName & "というファイルは存在します。"
End If

With Workbooks("test").Worksheets("マスタ0701").AutoFilterMode = False
With .Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp))
.AutoFilter Field:=13, Criteria1:=grp
'.CurrentRegion.Select
Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1")
'.AutoFilter
End With
End With

Next i

End Sub

回答No.6

kkkkkm · ベストアンサー

他の方の回答を改変するのは気が引けるのですが…。
元のコードのパターンだと以下のようにしてみてください。

With Workbooks("test_master").Worksheets("マスタ0701")
.AutoFilterMode = False
With .Range(.Cells(3, "B"), .Cells(Rows.Count, "CK").End(xlUp))
.AutoFilter Field:=13, Criteria1:=grp
'.CurrentRegion.Select
.SpecialCells(xlVisible).Copy Workbooks(grp).Worksheets("Sheet1").Range("A1")
'.AutoFilter
End With
End With

お礼

ちゃんと動きました！！！（涙）
手取り、足取り、お手間をお掛けいたしました。
まわりに詳しい人がいないため、とっても助かります。
今後とも宜しくお願いいたします！

回答No.5

kkkkkm

No.4の追加です。

No.4のコードの最後に
Set MyRange = Nothing
を入れておいた方がいいかもしれません。

回答No.4

kkkkkm

もしかして
https://okwave.jp/qa/q9784087.html
の回答で思ったようにならなかったので変更したのでしょうか
(エラーが解消されたとあったのでそのままでいけたのだと思いましたが)

Dimを追加してEnd If以降を以下のように変更して試してみてください。
grpには値を代入してください。

Dim MyRange As Range

With Workbooks("test_master").Worksheets("マスタ0701")
.AutoFilterMode = False
Set MyRange = .Range(.Cells(3, "B"), .Cells(Rows.Count, "CK").End(xlUp))
End With
MyRange.AutoFilter Field:=13, Criteria1:=grp
'.CurrentRegion.Select
MyRange.SpecialCells(xlVisible).Copy Workbooks(grp).Worksheets("Sheet1").Range("A1")
'MyRange.AutoFilter

回答No.3

imogasi

前回の質問の時に、自分の例でやってみて、回答締め切りになったので
そのままにしたが。また質問をだしているので、参考までに出してみる、
＝＝＝＝＝
暑いさなかで１字一句質問をチェックしてないので、的はずれの場合は
すみません。
プログラムエラー原因究明なんて、人に聞くべきもんでない、というのが自論です。
読者は、色々データやその他を触れない環境なのだから。。
===
自分で組んだプログラムでエラーが出てコードミス以外などで手こずった時の
１方法として、
（１）データを極く少数に減らしてサンプル的なデータを作る
（２）余分な処理を省いたコードを作り（今回ではＡｕｔｏｆｉｌｔｅｒらしい）
典型的な処理コードを作り
うまく行ったら、両者を比べて考えるのも、今までの小生の経験からやったことがある。
ーー
（１）今回の、何回かの質問では、データの例（模擬例）を挙げて質問してない。
（２）どの行で、どういうエラーコードが出たのかさえも説明してない。
　　ＶＢＡではこれが出るから、ほとんどエラー原因の究明に８割方困らない。
　　例えば、ＳＱＬやその他のソフト例えば正規表現などは、うまうく行かなかったら
　　（小生の力不足もありで）途方にくれるのに比べれば、やさしい。
ーーー
何度も同じ質問するのは、全般に人に頼りすぎな感じが強い。プログラムなど
、周りに相談できる先輩がいない環境で、やり始めるのなど無茶だ。
ーーー
私のやってみた例
データ例　Ｓｈｅｅｔ２　Ａ２：Ｄ１０
番号 コード 属性１ 属性２
12 asd 123 f
23 ABC 345 g
45 dfgh 664 h
67 er 34 j
45 qw12 22 k
42 de 2223 t
32 ABC 22 y
12 ABC1 55 y

コード
Sub 絞り込み2()
Worksheets("Sheet3").Cells.Clear
Dim grp
Set grp = Worksheets("Sheet1").Cells(3, 2)
grp = "ABC"
Set sh2 = Worksheets("Sheet2")
Worksheets("Sheet2").AutoFilterMode = False
'第2行目に項目見出しあり、第3行目以降がデータとする
With Worksheets("Sheet2").Range(sh2.Cells(2, "A"), sh2.Cells(10, "D")) '3でなく２ Sh2をcellsの前に付けること
.AutoFilter Field:=2, Criteria1:=grp
'.CurrentRegion.Select
'Sheet2は存在すること
Range(sh2.Cells(2, "B"), sh2.Cells(10, "D")).SpecialCells(xlVisible).Copy Worksheets("Sheet3").Range("A1")
'.AutoFilter
End With

End Sub
'With Worksheets("Sheet2").Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp))
'CK列が突然出てくるのはなぜ？
ーー
言いたいことは、
このVBAコードで、コメントを入れている部分が参考にならないかやってみてはどうか。
＝＝＝
結果
Ｓｈｅｅｔ３
コード 属性１ 属性２
ABC 345 g
ABC 22 y
＝＝＝
Autofilterは、見出し行の設定の有無や場所（セル範囲の先頭行指定）でうまくしないと
思わぬ行にフィルタボタンが出て、結果が１行少なくて戸惑う。

お礼

詳しくご教示下さり有難うございました！
大変助かりました。

回答No.2

kkkkkm

あと
End If以降が
https://okwave.jp/qa/q9784087.html
の回答と違ってるように見受けられます。

また、LOBの変数宣言もないと思います。

VBEのオプションで変数宣言を強制するにしておいた方がいいかもしれません。

行頭に
Option Explicit
が付きます。既存にはつかないかもしれませんので手動で付けてください。

お礼

Option Explicitの設定も行いました！
基本的なところからご教示いただき有難うございます。
これで今後は変数迷子にならずに済みそうです！

回答No.1

kkkkkm

Criteria1:=grp
ですが
grpに値が代入されていないように思いますがそのあたりはどうなのでしょう。