excel - 当值不为零时，循环通过列并将值复制到其他工作表vba excel

Question

我需要编写一个循环遍历工作簿最后一个工作表中的列（比如说 A）的宏，并将单元格中的值复制到另一个工作表中的相同位置（因此，如果第一个值在 A1 中，也是 A1）如果它们不是 0。我已经设法编写了一些代码，但我正在努力为我正在循环的范围设置范围。非常感谢您的帮助。

Sub tableonlycopywhen0()

Dim Cell As Range, cRange As Range
Dim wsDestination As Worksheet, wsSource As Worksheet
    
    'set worksheets
    With ThisWorkbook
        Set wsSource = .Worksheets(Sheets.Count)
        Set wsDestination = .Worksheets("Overview")
    End With
    

LastRow1 = Sheets(Sheets.Count).Cells(Rows.Count, "A").End(xlUp).Row
Set cRange = Sheets(Sheets.Count).Range(Sheets(Sheets.Count).Cells("A1:A" & LastRow1))
    For Each Cell In cRange
     If Cell.Value > 0 Then
        Cell.Copy
        Sheets("Overview").Select
        lastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
        wsDestination.Rows(lastRow).PasteSpecial Paste:=xlPasteValues
    End If
    
    Next Cell
    
End Sub

标签： excelvba

Answer 1

您已经建立wsSource，无需重复。当您可以使单元格相等时，也无需复制、选择和粘贴。

Sub tableonlycopywhen0()
    
    Dim Cell As Range, cRange As Range
    Dim wsDestination As Worksheet, wsSource As Worksheet
        
        'set worksheets
        With ThisWorkbook
            Set wsSource = .Worksheets(Sheets.Count)
            Set wsDestination = .Worksheets("Overview")
        End With
        
    
    LastRow1 = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
    Set cRange = wsSource.Range(wsSource.Cells(1,1),wsSource.Cells(LastRow1,1))
        For Each Cell In cRange
         If Cell.Value > 0 Then
            lastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
            wsDestination.Cells(lastRow,1)=Cell.Value
        End If
        
        Next Cell
        
    End Sub