[[20180131141701]]　『条件にあうものを別シートへコピーしたい』（黄色信号）　ページの最後に飛ぶ

『条件にあうものを別シートへコピーしたい』（黄色信号）

表のエクセルの　中に項目　列Lに　発送手段　という項目があり　メール便　個口発送の　どちらかが入力されています。

上記の表があるシート名が　"発送先ﾘｽﾄ"です。

シート名　発送先ﾘｽﾄ　　の中にある表の　列L　がメール便だった時は
シート名　最新メール便　　へ条件にあうものだけ表をコピー
シート名　発送ﾘｽﾄ　　の中にある表の　列L　が個別発送だった時は
シート名　最新西濃　　　へ条件にあうものだけ表をコピー
したく
下記のものを　ネットで検索しながら　記入しましたが

下記の　コピーしたいところの　指定する箇所がエラーとなってしまいます。
どのように直したらよいでしょうか？
よろしくお願いします。

 Worksheets("発送先ﾘｽﾄ").Select
             Range("A1").CurrentRegion.Select.Copy Worksheets("最新西濃").Range("A1")         'シート[最新西濃]へコピーする

上記　場所が　エラーとなってしまいます。

Sub マクロテスト()
'
' マクロテスト Macro
'

 Worksheets("最新メール便").Cells.Clear    
 　　'シート　最新メール便　データを削除する
 Worksheets("最新西濃").Cells.Clear        
 　　'シート　最新西濃データを削除する

   Dim I As Long, length As Integer

       For I = 2 To Cells(Rows.Count, 12).End(xlUp).Row  
　　　　　　　'列[L]に関して2行目から最終行まで処理

         If Cells(I, 12) = "個口発送" Then                                                    　　　　　　　　'もし列[L]の中に　”個口発送”　があったら

             Worksheets("発送先ﾘｽﾄ").Select
             Range("A1").CurrentRegion.Select.Copy Worksheets("最新西濃").Range("A1")         'シート[最新西濃]へコピーする

           ElseIf Cells(I, 12) = "メール便" Then                                              'もし列[L]の中に”メール便”　があったら
             Worksheets("発送先ﾘｽﾄ").Select
             Range("A1").CurrentRegion.Select.Copy Worksheets("最新メール便").Range("A1")      'シート[最新メール便]へコピーする

        End If

     Next I

End Sub

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

おそらく、標準モジュールに記述されているんだとおもいますので、それを前提としてですが

（１）
For I = 2 To Cells(Rows.Count, 12).End(xlUp).Row
という記述は、
For I = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 12).End(xlUp).Row
と理解されます。

そして、このコード以前にはシートを選択する命令は記述されていませんので、どのシートで
L列の値が「個口発送」となっているセルを探したいのかが回答者にわかりません。

（２）
Worksheets("発送先ﾘｽﾄ").Select
Range("A1").CurrentRegion.Select.Copy　～～～

この部分でエラーになるんだとおもいますが、単純にメソッド（命令）が重複してるからです。
簡単にいうと　Select　と　Copy　という命令が重複してます。

コードの流れをみると、.Selectはいりません。　

（もこな２） 2018/01/31(水) 16:05

（２）を修正したとして、追加です。

（３）
（２）の部分を整理すると、こうなるとおもいますが、

 If Cells(I, 12).Value = "個口発送" Then
 　Worksheets("発送先リスト").Range("A1").CurrentRegion.Copy _
        Worksheets("最新西濃").Range("A1")
 ElseIf Cells(I, 12).Value = "メール便" Then
    Worksheets("発送先リスト").Range("A1").CurrentRegion.Copy _
        Worksheets("最新メール便").Range("A1")
 End If

結局コピーされるのはどちらも「Worksheets("発送先リスト").Range("A1").CurrentRegion」となりますし、コピー先も起点は「A1」セルで固定になってますので、質問文の「条件にあるものだけ表をコピー」とはなってませんが、よろしいのでしょうか？

これらをふまえると、とりあえず、コード云々はおいておいて、やりたいことを箇条書きにして整理してみたほうがよいとおもいます。
【整理の例】
１．「発送先リスト」のL列の2行目から最終行までのセル値を順番に見ていって・・・

２．”個口発送”ってなっていたら「発送先リスト」のA1セルを含む表を、「最新西濃」シートのA1に貼り付ける
３．”メール便”ってなっていたら「発送先リスト」のA1セルを含む表を、「最新メール便」シートのA1に貼り付ける

※（３）のとおり、現状だと、２，３のコピー元、貼付先、どちらも固定なので、何度繰り返しても同じになるとおもいますので、現状のままでOKというのであれば、そもそもループする処理はいらないかもしれないです。

（もこな２） 2018/01/31(水) 16:49

もこな2さんありがとうございます。
いろいろすみません。

(1)は発送先ﾘｽﾄシートの L列です。

行いたい事

１．「発送先リスト」のL列の2行目から最終行までのセル値を順番に見ていって・・・

２．”個口発送”ってなっていたら「発送先リスト」のA1セルを含む表を、「最新西濃」シートのA1に貼り付ける

３．”メール便”ってなっていたら「発送先リスト」のA1セルを含む表を、「最新メール便」シートのA1に貼り付ける

です。
すみません。下記についてよくわからないので教えて下さい。

※（３）のとおり、現状だと、２，３のコピー元、貼付先、どちらも固定なので、何度繰り返しても同じになるとおもいますので、現状のままでOKというのであれば、そもそもループする処理はいらないかもしれないです。

 もし、発送先ﾘｽﾄシートのL列が 個口発送だったら
   最新西濃シート  に 上記条件をみたすものを
   発送先ﾘｽﾄシートに出ている表を全ての項目をコピー したい。

 もし、発送先ﾘｽﾄシートのL列が メール便だったら
   最新メール便シート に上記条件をみたすものを
   発送先ﾘｽﾄシートに出ている表全ての項目をコピー したい

⬆のような事が出来るマクロを作りたいと思っています。

     A1 が含まれる と指定したのは
     条件を満たした  表 全てをコピーしたくて
    入力してしまいました。

どのように変更したらよいでしょうか？

すみません。よろしくお願いします。

（黄色信号） 2018/01/31(水) 17:59

「条件を満たした表全て」というのがよくわからないです。
結局のところ、「発送リスト」のL列によって、「西濃」と「メール便」それぞれのシートに振り分けながら行単位でコピーしたいのかなとおもいましたので、Sampleコードを提供します。
（テストしてないのでバグあるかもです）
Sub マクロテスト改()
'==変数宣言など

    Dim i As Long
    Dim 最終列 As Long
    Dim 西濃行 As Long, メル便行 As Long
    西濃行 = 1
    メル便行 = 1

'==処理

    'クリア処理（対象シートの全セルの値、書式、コメント等をクリア）
    Worksheets("最新メール便").Cells.Clear
    Worksheets("最新西濃").Cells.Clear

    '振分けコピー
    With Worksheets("発送先ﾘｽﾄ")
        最終列 = .Range("A1").CurrentRegion.Columns.Count
        For i = 2 To .Cells(.Rows.Count, "L").End(xlUp).Row
            Select Case .Cells(i, "L").Value

                Case Is = "個口発送"
                    .Range(.Cells(i, "A"), .Cells(i, 最終列)).Copy _
                        Worksheets("最新西濃").Cells(西濃行, "A")
                    西濃行 = 西濃行 + 1

                 Case Is = "メール便"
                    .Range(.Cells(i, "A"), .Cells(i, 最終列)).Copy _
                        Worksheets("最新メール便").Cells(メル便行, "A")
                    メル便行 = メル便行 + 1

            End Select
        Next i
    End With

End Sub
（もこな２） 2018/01/31(水) 18:23

スマホからなので単文にて
おっしゃるとおりなら、ループさせるんじゃなくて
L列に"個口発送"が1以上あるならコピーする
L列に"メール便"が1以上あるならコピーする
ってのを1回やればいいでしょう
（もこな２） 2018/01/31(水) 18:42

もこな2さん
ありがとうございます。

「条件を満たした表全て」というのがよくわからないです。説明がわかりにくくてすみません。

やりたいことはまさしく下記です

「発送リスト」のL列によって、「西濃」と「メール便」それぞれのシートに振り分けながら行単位でコピーしたい

あいにく
自宅では上記sampleコードを
試せる環境にないため、明日(会社にて)
行ってみます。お忙しい所ありがとうございます。

（黄色信号） 2018/01/31(水) 19:07

テスト実行してみたところ、シート名を2カ所ほど間違えていたので、修正しました。
それ以外は、たぶん希望と思われる動作になりましたので、これでよければ、ステップ実行してみて各変数にどのような値が格納されているかなど、研究してみて下さい。

よくわからないメソッド（命令）やステートメント（記述方法？）があったら、まずは、グーグル先生に聞いてみて、それでもよくわからなかったら追加質問して下さい。

私が居なくても、他の回答者さんがあっという間に答えてくれると思います。
（もこな２） 2018/01/31(水) 19:36

オートフィルタとかフィルタオプションを使うとよいです。

 Option Explicit

 Sub test()
    Dim ws As Worksheet
    Dim r As Range
    Dim c As Range

    Set ws = Sheets("発送先ﾘｽﾄ")
    Set r = ws.Cells(1).CurrentRegion
    Set c = ws.Cells(1, Columns.Count).Resize(2)
    c(1).Value = ws.Range("L1").Value

    c(2).Value = "メール便"
    r.AdvancedFilter xlFilterCopy, c, Sheets("最新メール便").Cells(1)
    c(2).Value = "個口発送"
    r.AdvancedFilter xlFilterCopy, c, Sheets("最新西濃").Cells(1)

    c.ClearContents

 End Sub

（マナ） 2018/01/31(水) 20:52

もなこ2さん　マナさん　　ありがとうございます。

もなこ2さん　希望の　シート別のコピー出来ました。

振り分け　シート分けを行った際に
1行目に　発送先ﾘｽﾄシートの　1行目にあった　項目行を

コピー先の　最新メール便　　最新西濃　　へ付け足すのを追加するとしたら

'==変数宣言など

    Dim i As Long
    Dim 最終列 As Long
    Dim 西濃行 As Long, メル便行 As Long
    西濃行 = 1
    メル便行 = 1
'==処理 
    'クリア処理（対象シートの全セルの値、書式、コメント等をクリア）
    Worksheets("最新メール便").Cells.Clear
    Worksheets("最新西濃").Cells.Clear
    '振分けコピー
    With Worksheets("発送先ﾘｽﾄ")
        最終列 = .Range("A1").CurrentRegion.Columns.Count
        For i = 2 To .Cells(.Rows.Count, "L").End(xlUp).Row
            Select Case .Cells(i, "L").Value
                Case Is = "個口発送"
                    .Range(.Cells(i, "A"), .Cells(i, 最終列)).Copy _
                        Worksheets("最新西濃").Cells(西濃行, "A")
                    西濃行 = 西濃行 + 1
                 Case Is = "メール便"
                    .Range(.Cells(i, "A"), .Cells(i, 最終列)).Copy _
                        Worksheets("最新メール便").Cells(メル便行, "A")
                    メル便行 = メル便行 + 1
            End Select
        Next i
    End With

※　ここの部分に　記入すればよいでしょうか？？？？

　End Sub

マナさん
まだ、まだ、　記入していただいた　マクロ文を　ひとつひとつ単語を調べるレベルのため
変数の中に変数（例：Set r = ws.Cells(1).CurrentRegion）　というのが難しくまだ　処理の理解ができません。すみません。すこしずつ　すこしずつ調べてみます。　ありがとうございます。

（黄色信号） 2018/02/01(木) 10:12

2行目からループスタートしてるってことは1行目は項目でしょうから、もっと簡単な方法としてオートフィルタ・・・って説明しようとしたら、既にマナさんがフォローされてましたね。
せっかく作ったので、投稿しておきます。（オートフィルタを使った例です。）

Sub Sample3()
'==変数宣言など

    Dim 抽出条件 As Variant
    Dim Sh_names As Variant
    Dim i As Integer
    Dim listSH As Worksheet
    抽出条件 = Array("個口発送", "メール便")
    Sh_names = Array("最新西濃", "最新メール便")
    Set listSH = Worksheets("発送先リスト")

'==処理

    Stop '←学習用です（コードの実行には無くても問題なしというかあったら止まります）
    listSH.Activate '←学習用です（コードの実行には不要）
    'オートフィルタが設定されていたら抽出状態をクリアするため一旦解除します。
    If listSH.AutoFilterMode Then listSH.Range("A1").AutoFilter

    For i = 0 To UBound(Sh_names)
        With Worksheets(Sh_names(i))
            listSH.Activate '←学習用です（コードの実行には無くても問題なし）
            listSH.Range("A1").AutoFilter Field:=12, Criteria1:=抽出条件(i)

            .Activate '←学習用です（コードの実行には無くても問題なし）
            .Cells.Clear
            listSH.Range("A1").CurrentRegion.Copy .Range("A1")
        End With
    Next i
End Sub

興味があったら、ブックとVBEのウィンドウを並べてから、↑をステップ実行して、どのような処理が行われているか、また、各変数がどのように変わっていくか研究してみてください。
（もこな２） 2018/02/01(木) 11:33

もこな2さん　　

今！！気が付きました。　
すみません。　10：12の　文章にて　お名前を　間違て入力していました。
大変失礼しました。

11：33　のマクロ　も　ひとつ　ひとつ　単語をすこしずつ　調べてみます。
ありがとうございます。
（黄色信号） 2018/02/01(木) 11:46

もこな2さん　マナさん
ありがとうございます。

オートフィルタ　というものを教えていただいているのに
すみません。
下記のように　
項目行用の　行を　挿入し
項目を　コピーして
各シートへ項目を貼り付ける　と処理を付け足してみました。
処理自体は行いたいようにできたのですが

発送先ﾘｽﾄ　シートの　1行目の　項目に　コピーの範囲指定に　点線
などが　出ていました。
コピー貼り付けの箇所は　このような感じで良いでしょうか？？？
今、　出来る　範囲で　教えてもらったコードを使いながら
行っています。　オートフィルタに　ついては　まだです。すみません。

' シートを分ける Macro
'メール便
'西濃　でシートを分ける

'==変数宣言など

   Dim iii
    Dim 最終列 As Long
    Dim 西濃行 As Long, メル便行 As Long
    西濃行 = 1
    メル便行 = 1
'==処理
    'クリア処理（対象シートの全セルの値、書式、コメント等をクリア）
    Worksheets("最新メール便").Cells.Clear
    Worksheets("最新西濃").Cells.Clear
    '振分けコピー
    With Worksheets("発送先リスト")
        最終列 = .Range("A1").CurrentRegion.Columns.Count
        For iii = 2 To .Cells(.Rows.Count, "L").End(xlUp).Row
            Select Case .Cells(iii, "L").Value
                Case Is = "個口発送"
                    .Range(.Cells(iii, "A"), .Cells(iii, 最終列)).Copy _
                        Worksheets("最新西濃").Cells(西濃行, "A")
                    西濃行 = 西濃行 + 1
                 Case Is = "ﾒｰﾙ便"
                    .Range(.Cells(iii, "A"), .Cells(iii, 最終列)).Copy _
                        Worksheets("最新メール便").Cells(メル便行, "A")
                    メル便行 = メル便行 + 1
            End Select
        Next iii
    End With

   '　項目行　用の　挿入　とコピー貼り付け
    Sheets("最新西濃").Rows(1).Insert         '最新西濃　シート　の1行目　に　行挿入
    Sheets("発送先リスト").Rows(1).Copy       '発送先ﾘｽﾄ　シート　1行目の　項目を　コピーする
    Sheets("最新西濃").Rows(1).PasteSpecial  '最新西濃　シート　1行目に　貼り付ける

    Sheets("最新メール便").Rows(1).Insert        '最新メール便　シート　の1行目に行を挿入
    Sheets("発送先リスト").Rows(1).Copy          '発送先ﾘｽﾄ　シート　1行目の　項目を　コピーする
    Sheets("最新メール便").Rows(1).PasteSpecial  '最新メール便　シート　1行目に　貼り付ける

End Sub

（黄色信号） 2018/02/01(木) 14:15

＞発送先リスト　シートの　1行目の　項目に　コピーの範囲指定に　点線などが　出ていました。
コピーのために選択した範囲の点線では？
手動でEscキーおすか、コードの最後に　Application.CutCopyMode = False　を組み込めばいいとおもいます。
（参考）
https://www.moug.net/tech/exvba/0150014.html

コードの方は・・ステップ実行して研究してみましたか？

気になる点として
（１）なんで変数「i」を「iii」に変更したんでしょうか？ダメじゃ無いけど見づらいし、
　　　書きづらくないですか？

（２）項目行を貼り付ける前に行挿入してますけど、工夫すればいらないですよね
　　【ヒント１：何行目から貼り付けるのかを決めてるのはどこでしょうか？】
　　【ヒント２：なんで、「1」行目から貼り付けられているのでしょうか？】

（３）PasteSpecialメソッドを実行するまえに、対象シートをアクティブにする
　　　必要があったような気もします。（普段使わないので私にはわかりません）
　　　ただ、それ以外でも、なんでPasteSpecialしたいのかわかりません。
　　　Pasteメソッドで十分な気もしますし、Pasteメソッド実行するくらいなら、
　　　私なら、Copyメソッドの引数として貼付先を渡しちゃいます
（もこな２） 2018/02/01(木) 14:58

もこな2さん
ありがとうございます。

(1)の変数をiから iiiへの変更は
このマクロの前に行っている(動いているマクロがあり)
そちらで変数i を使っていたので
提示していててだいたマクロの変数i部分をiiiと変更しました。

(2)まだどこだろう？？？と難しいですが
ヒントを見ながら
直したらよい場所をさがして
明日、いじってみます。

(3)PasteSpesialメゾットとPasteメゾットがある事を知らずに
ネットでコピー貼り付けを検索し
使えそうなものを項目名を変更して
使用してしまいました。

Copyメソッドの引数として貼付先を渡しちゃいます ⬆についても再度検索して使ってみようと思います。

マクロは奥が深いですね～
回答を頂く度に思います。

ありがとうございます。

（黄色信号） 2018/02/01(木) 17:13

＞(2)まだどこだろう？？？と難しいですが

う～ん、、、ヒントがわるいんですかね。。。

○○行　＝　１　
ってどこかに書いてありませんか？
（もこな２） 2018/02/01(木) 18:11

もこな2さん
ありがとうございます。

いえいえ　ヒント　があるだけでとてもありがたいです。
こちらが　理解が悪くて　多分　ここだろう　というのを
会社で試すまで　自信がありませんでした。

コピー　ペースト　の箇所も　簡潔　に直すことができました。
（動作も確認しました。）
ありがとうございます。

'==変数宣言など

   Dim iii
    Dim 最終列 As Long
    Dim 西濃行 As Long, メル便行 As Long
    西濃行 = 2
    メル便行 = 2
'==処理
    'クリア処理（対象シートの全セルの値、書式、コメント等をクリア）
    Worksheets("最新メール便").Cells.Clear
    Worksheets("最新西濃").Cells.Clear
    '振分けコピー
    With Worksheets("発送先リスト")
        最終列 = .Range("A1").CurrentRegion.Columns.Count
        For iii = 2 To .Cells(.Rows.Count, "L").End(xlUp).Row
            Select Case .Cells(iii, "L").Value
                Case Is = "個口発送"
                    .Range(.Cells(iii, "A"), .Cells(iii, 最終列)).Copy _
                        Worksheets("最新西濃").Cells(西濃行, "A")
                    西濃行 = 西濃行 + 1
                 Case Is = "ﾒｰﾙ便"
                    .Range(.Cells(iii, "A"), .Cells(iii, 最終列)).Copy _
                        Worksheets("最新メール便").Cells(メル便行, "A")
                    メル便行 = メル便行 + 1
            End Select
        Next iii
    End With

    Worksheets("発送先リスト").Rows(1).Copy Worksheets("最新西濃").Rows(1)     
  '発送先ﾘｽﾄ　シート　1行目の　項目を　コピー し　最新西濃　シート　1行目へ貼り付ける

    Worksheets("発送先リスト").Rows(1).Copy Worksheets("最新メール便").Rows(1) 
  '発送先ﾘｽﾄ　シート　1行目の　項目を　コピー　し　最新メール便　シート　1行目へ貼り付ける

End Sub

（黄色信号） 2018/02/02(金) 12:31

コメント返信：

[ 一覧(最新更新順) ]

[[20180131141701]] 『条件にあうものを別シートへコピーしたい』（黄色信号） ページの最後に飛ぶ

[[20180131141701]]　『条件にあうものを別シートへコピーしたい』（黄色信号）　ページの最後に飛ぶ