循环通过列，并在值不是零时将值复制到其他工作表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

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

Answer 2

您编写了：并将单元格中的值复制到相同的位置

此代码按您的要求运行：

Sub tableonlycopywhen1()

Dim Cell As Range, cRange As Range, lrw As Long
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.Cells
If Cell.Value > 0 Then wsDestination.Cells(Cell.Row, Cell.Column) = Cell.Value
Next Cell

End Sub