VBA Two for Loop並將值收集到第二張

Question

我試圖讓這個子程序工作。 （ws）.Range（「E5」）。end（xldown）.offset（1，0，0）如果數據不是0到循環並複製數據，我有一張數據（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