dポイントプレゼントキャンペーン実施中!

以下のコードを使用してメーカー毎にシートを指定して振り分けているのですが
指定した分はしっかりと振り分けられるのですが指定していないメーカー名は用意したシートに
全てコピーされてしまいます。
どこが悪いか分からず、直すところを教えてもらえないでしょうか?

Sub 発注書作成()

Dim m As String, i As Long
Dim arry As Variant

m = "メーカー1,メーカー2,メーカー3,メーカー4,メーカー5,メーカー6,メーカー7,メーカー8,メーカー9,メーカー10,メーカー11"
arry = Split(m, ",")

Worksheets("出荷指図書").Activate

If ActiveSheet.AutoFilterMode = False Then
Range("C8:C18").AutoFilter
End If

'メーカーごとにコピー
Application.ScreenUpdating = False
For i = 1 To 11 'メーカーシートの数
Worksheets("出荷指図書").Activate
ActiveSheet.Range("$C$6:$C$16").AutoFilter Field:=1, Criteria1:=arry(i - 1)
Range("D9:G18").Copy
Worksheets(arry(i - 1)).Activate
Range("A11").PasteSpecial Paste:=xlPasteValues
'お客様名
Worksheets("出荷指図書").Activate
Range("D6").Copy
Worksheets(arry(i - 1)).Activate
Range("E11").PasteSpecial Paste:=xlPasteValues
'発注書印刷
If WorksheetFunction.Sum(Range("C11:C20")) <> 0 Then
ActiveSheet.PrintPreview 'PrintOut
End If
Next
Worksheets("出荷指図書").Activate
ActiveSheet.Range("$C$6:$C$16").AutoFilter
Application.ScreenUpdating = True

End Sub

「マクロのコードについて教えてください」の質問画像

A 回答 (2件)

下記でどうでしょうか。


フィルター後、表示された行が0なら、転記しないようにしています。
(プレビューも行いません)
フィルター後の表示行の取得は、
https://www.excel-chunchun.com/entry/20200613-ex …
をそのまま使っています。

Sub 発注書作成()

Dim m As String, i As Long
Dim arry As Variant

m = "メーカー1,メーカー2,メーカー3,メーカー4,メーカー5,メーカー6,メーカー7,メーカー8,メーカー9,メーカー10,メーカー11"
arry = Split(m, ",")

Worksheets("出荷指図書").Activate

If ActiveSheet.AutoFilterMode = False Then
Range("C8:C18").AutoFilter
End If

'メーカーごとにコピー
Application.ScreenUpdating = False
For i = 1 To 11 'メーカーシートの数
Worksheets("出荷指図書").Activate
ActiveSheet.Range("$C$6:$C$16").AutoFilter Field:=1, Criteria1:=arry(i - 1)
Dim displine
displine = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If displine > 0 Then
Range("D9:G18").Copy
Worksheets(arry(i - 1)).Activate
Range("A11").PasteSpecial Paste:=xlPasteValues
'お客様名
Worksheets("出荷指図書").Activate
Range("D6").Copy
Worksheets(arry(i - 1)).Activate
Range("E11").PasteSpecial Paste:=xlPasteValues
'発注書印刷
If WorksheetFunction.Sum(Range("C11:C20")) <> 0 Then
'ActiveSheet.PrintPreview 'PrintOut
End If
End If
Next
Worksheets("出荷指図書").Activate
ActiveSheet.Range("$C$6:$C$16").AutoFilter
Application.ScreenUpdating = True

End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
今、詳しくいろいろ調べたところエクセルのfilter関数でも
似たようなことができたのでそちらを使用しようと思います。
また、質問した際はご回答よろしくお願いします

お礼日時:2023/11/10 12:53

こんにちは



手操作あるいはステップ実行してみれば、すぐにわかると思いますけれど・・・

そういう仕様になっているようです。
Copyメソッドは、通常は、指定された範囲内の「表示セル」だけをコピーしますけれど、「非表示の範囲だけ」を指定してコピーした場合には、そのままその範囲がコピーされるようです。
(多分、コピー対象が何も無いので、指定された範囲をコピーしているのかと)
この結果、ご質問のような事象になっているものと考えられます。


>どこが悪いか分からず、直すところを教えてもらえないでしょうか?
原因は上記ですが、ご提示のままの処理で行うのなら、フィルターの結果を判定してからコピー処理を行えば宜しいかと。

まるっきり考え方を変えても良ければ、
 ・元シートの一つ分のデータを、メーカー別シートに振り分ける
という処理をデータ分だけループでくりかえせば、こちらでも可能でしょう。
(こちらの場合は、フィルター操作は不要になります)
    • good
    • 0
この回答へのお礼

こんにちは
先日から回答ありがとうございます。
仕様の可能性もあるのですね。
フィルター操作不要の方法で作成してみようかと思います。
また、質問する際はご教授お願いします

お礼日時:2023/11/10 12:01

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

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


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