VBA オブジェクト（セレクトに格納した値）を別のブックに表示

Question

分からない点はsheet2.Cells(row2, col2) = colect.item(i) をコレクトの値をループさせて別のブックのセルに表示する方法**
Const ST_ROW As Long=4
Const ST_COL As Long=2
Sub 数と日付()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim ary() As String
Dim row As Long
Dim col As Long
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim lastRow As Long
Dim lastcol As Long
Dim index As Long
Dim index2 As Long
Dim colect As Collection, item As Variant Set colect=New Collection sPath="Book11.xlsx"
Set Wb1=ThisWorkbook 'コピー先ブック

Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック Set
sheet1=Wb2.Worksheets("コピー元")
Set sheet2=Wb1.Worksheets("コピー先")
lastRow=sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row lastcol=sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column ReDim ary(0, lastcol - ST_COL) For row=ST_ROW To lastRow
If sheet1.Cells(row, 4) >= 2 Then
For col=ST_COL To lastcol
ary(index, index2) = sheet1.Cells(row, col)
index2=index2+1
Next colect.Add ary End If index2 = 0
Next Dim row2 As Long
Dim col2 As Long
Dim i As Long

ここから下が不明点
For row2=2 To colect.Count
For col2=1 To 4 sheet2.Cells(row2,
col2)=colect.item(i)
col2=col2+1 Next col2=0 Next
sheet2.Range("A1:D1").Value=sheet1.Range("B3:E3").Value With ActiveSheet .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes End WithEnd Sub

Comments

[neconekocat]

読みにくいとかそういう次元ではないのでMarkdownの記法に従って修正をお願いします。

[meg_]

コードは「コードの挿入」で記入してください。

Answer 1

（とりあえず整形）

Const ST_ROW As Long = 4
Const ST_COL As Long = 2

Sub 数と日付()
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim ary() As String
    Dim row As Long
    Dim col As Long
    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim lastRow As Long
    Dim lastcol As Long
    Dim index As Long
    Dim index2 As Long
    Dim colect As Collection, item As Variant
    Set colect = New Collection
    sPath = "Book11.xlsx"
    Set Wb1 = ThisWorkbook 'コピー先ブック
    
    Set Wb2 = Workbooks("Book11.xlsx") 'コピー元（参照する）ブック
    Set sheet1 = Wb2.Worksheets("コピー元")
    Set sheet2 = Wb1.Worksheets("コピー先")
    lastRow = sheet1.Cells(Rows.Count, ST_COL).End(xlUp).row
    lastcol = sheet1.Cells(ST_ROW, Columns.Count).End(xlToLeft).Column
    ReDim ary(0, lastcol - ST_COL)
    For row = ST_ROW To lastRow
        If sheet1.Cells(row, 4) >= 2 Then
            For col = ST_COL To lastcol
                ary(index, index2) = sheet1.Cells(row, col)
                index2 = index2 + 1
            Next
            colect.Add ary
        End If
        index2 = 0
    Next
    Dim row2 As Long
    Dim col2 As Long
    Dim i As Long
    
    ここから下が不明点
    For row2 = 2 To colect.Count
        For col2 = 1 To 4
            sheet2.Cells(row2, col2) = colect.item(i)
            col2 = col2 + 1
        Next
        col2 = 0
    Next
    sheet2.Range("A1:D1").Value = sheet1.Range("B3:E3").Value
    With ActiveSheet
        .Range("A1").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlYes
    End With
End Sub

---

＜追記＞
あなたにとって i とは何なのか、見失ってはいませんか。

    For i = 1 To colect.Count
        sheet2.Cells(i + 1, 1).Resize(, 4).Value = colect.item(i)
    Next

これが正しいかどうかは、私にもわかりません。
あなた自身で確かめてみてください。