連続したデータを１行づつ離して貼り付け

Question

Sub Sample()
    Dim i As Integer
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    Dim DatePart As Integer
    Dim ColRead As String
      
    Dim rowsData As Long 
    rowsData = ws1.Range("A2").End(xlDown).Row - 1  
        
    For i = 2 To rowsData
        
    ColRead = ws1.Cells(i, "E")
        
        If ColRead = "AA" Or "BB" Then
            ws1.(Cells(i, "A"),Cells(i, "B"),Cells(i, "C"), Cells(i + 1, "D")).Copy
            ws2.Cells(i, 2).PasteSpecial Paste:=xlPasteValues
              
        Else: ColRead = "CC"
            ws1.Rows(i).Copy
            ws2.Rows(i).PasteSpecial Paste:=xlPasteValues
        End If
     Next
End Sub

<エラー箇所＞
と作成しましたが
If ColRead = "AA" Or "BB" Then
ws1.(Cells(i, "A"),Cells(i, "B"),Cells(i, "C"), Cells(i + 1, "D")).Copy
ws2.Cells(i, 2).PasteSpecial Paste:=xlPasteValues

の記載が間違っているようなのですが自分ではよくわかりませんでした。

<やりたいこと>
①Sheet1にデータがあり、E列に条件として、今のところ順番は「AA」「BB」「CC」の３つの順番が入っています。E列にAA,BBが入力されている場合、C列のAA列を・D列はBB列をコピーしsheet2へ貼り付けて一覧にしたいです。
②さらにE列にCCが入力されている場合、AからD列をコピーし貼り付け
③上から順に繰り返す
④毎回列の数は変わります

どのようにしたらうまく行くのかご教示頂けないでしょうか、よろしくお願いします

Comments

[meg_]

「AA」「BB」「CC」は必ずこの順番で1回ずつ順に現れるのですか？

[meg_]

「セルデータを読み込んでくれません 」とはどういう意味ですか？

[koko2]

ご連絡ありがとうございます。今のところ順番は「AA」「BB」「CC」の３つの順番です。「セルデータを読み込んでくれません 」とは、自分で作成してみて、データ一覧が上記でできると思ったのですが、IF関数の使い方や繰り返し処理がうまく書けていないようで、If ColRead = "AA" Or "BB" Then以降で苦戦しています。すみませんがよろしくお願いいたします。

Answer 1

あなたのソースを極力いかすようにして、修正しました。
以下のようにしてください。
変数i等はLong型で確保するようにしてください。
Intgerだと-32768~32767の範囲しか保持できません。32767行を超えると動作がおかしくなります。

Sub Sample()
    Dim i As Long
    Dim j As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    Dim DatePart As Integer
    Dim ColRead As String

    Dim rowsData As Long
    rowsData = ws1.Range("A2").End(xlDown).row
    j = 2
    For i = 2 To rowsData

        ColRead = ws1.Cells(i, "E").Value

        If ColRead = "AA" Then
            ws2.Cells(j, "A").Value = ws1.Cells(i, "A").Value   '商品設定
            ws2.Cells(j, "B").Value = ws1.Cells(i, "B").Value   'size設定
            ws2.Cells(j, "C").Value = ws1.Cells(i, "C").Value   '単価１設定
        End If
        If ColRead = "BB" Then
            ws2.Cells(j, "D").Value = ws1.Cells(i, "D").Value   '単価２設定
            j = j + 1                                           'Sheet2の次の行設定
        End If
        If ColRead = "CC" Then
            ws2.Cells(j, "A").Value = ws1.Cells(i, "A").Value   '商品設定
            ws2.Cells(j, "B").Value = ws1.Cells(i, "B").Value   'size設定
            ws2.Cells(j, "C").Value = ws1.Cells(i, "C").Value   '単価１設定
            ws2.Cells(j, "D").Value = ws1.Cells(i, "D").Value   '単価２設定
            j = j + 1                                           'Sheet2の次の行設定
        End If
    Next
End Sub

Comments

[koko2]

出来ました！
こういう風にすればいいんですね

本当に助かりました。ありがとうございます。

Answer 2

エラーは下記でなくなるかと思います

If ColRead = "AA" Or ColRead ="BB" Then

但し、「AA」のときと「BB」のときとでその後の処理が変わるので上記でエラーがなくなっても希望通りのマクロにはならないでしょう。
「AA」のときと「BB」のときでそれぞれIf文を書くべきかと思います。

Comments

[koko2]

回答ありがとうございました。私の説明が悪くて申し訳ありません。
ws1.(Cells(i, "A"),Cells(i, "B"),Cells(i, "C"), Cells(i + 1, "D")).Copy
ws2.Cells(i, 2).PasteSpecial Paste:=xlPasteValues
ここが不明点なのですが、おそらくご説明頂いたように、「AA」のときと「BB」のときと書くべきですね。がんばってみます。

[meg_]

確認ですが「If ColRead = "AA" Or "BB" Then」のところでエラーは出ていない、という理解で良いですか？