VBA Two for Loopと2番目のシートに値を収集します

Question

このサブルーチンを動作させようとしています。

値が0（シート）（ws）.Range（ "E5"）.end（xldown）.offset（1、0）にループしてデータをコピーする1つのシート（ws1） 0）

---

Sub Test() 

Dim r As Integer 
Dim c As Integer 
Dim amount As Long 
Dim account As Variant 
Dim Acct As Range 
Dim Amt As Range 
Dim ws1 As Worksheet 
Dim target As Range 
Dim ws As Worksheet 
Set ws1 = ActiveSheet 
Set ws = Worksheets("Updated") 
Set target = ws.Range("E5:E" & Range("E5").End(xlDown)).Select 

    ws1.Activate 

    Range("A8").Select 

    For r = 8 To ActiveCell.End(xlDown).Row 

    Cells(r, 1).Select 
    account = ActiveCell.Value 

    For c = 2 To ActiveCell.End(xlToRight).Column 

    ActiveCell.Offset(0, 1).Select   
    amount = ActiveCell.Value 

    If ActiveCell.Value <> 0 Then 

    target.Offset(1, 0).Value = amount  
    target.Range("E5").End(xlDown).Offset(0, 1) = account 

    End If 

    Next  
     Next 

    ActiveCell.Offset(1, 0).Select 

    End Sub 

Answer 1

を助けてください、これを試してみてください：

Sub Test() 

Dim source As Worksheet, target As Worksheet, rng As Range, col As Integer, account As Range 

Set source = ActiveSheet 
Set target = Worksheets("Updated") 

For Each rng In source.Range("A8:A" & Range("A8").End(xlDown).Row) 

    Set account = rng 

    For col = 2 To rng.End(xlToRight).Column 

     If Cells(rng.Row, col) <> 0 Then 

      target.Range("E5").End(xlDown).Offset(1, 0) = Cells(rng.Row, col) 
      target.Range("E5").End(xlDown).Offset(0, 1) = account 

     End If 

    Next col 

Next rng 

End Sub