Question

我有一组表格中的一组数据是H11：BG25。我想运行一些代码来查看每一列，如果该列的总和是＆gt; 0，然后复制该列的整个范围。如果总和是＆lt; 0，什么都不做。到目前为止，我有以下代码，但它不复制它只复制非0值的范围。

Sub CopyActuals()

For iCol = 8 To 59
For iRow = 11 To 25

  With Worksheets("Project - Actual (Hours)").Cells(iRow, iCol)
    ' Check that cell is not empty.

        If 'Condition to be if there is any data in the rows 11-25 for each column, then copy the whole column

        Else
                Worksheets("Project - Actual (Hours)").Cells(iRow, iCol).Copy
                Worksheets("Project - Budget (Hours)").Cells(iRow, iCol).PasteSpecial Paste:=xlPasteValues
                Worksheets("Project - Budget (Hours)").Cells(iRow, iCol).PasteSpecial Paste:=xlPasteFormats

        End If

End With

    Next iRow
Next iCol

End Sub

Answer 1

Sub CopyActuals()
Dim ActlSheet As Worksheet
Dim BbgtSheet As Worksheet
Dim rowCount As Integer
Dim SumValue As Integer
Dim rng As Range
Set ActlSheet = ActiveWorkbook.Sheets("Project - Actual (Hours)")
Set BbgtSheet = ActiveWorkbook.Sheets("Project - Budget (Hours)")
rowCount = ActlSheet.UsedRange.Rows.Count
For iCol = 8 To 59
 Set rng = Range(Cells(11, iCol), Cells(rowCount, iCol))
 SumValue = Application.WorksheetFunction.Sum(rng)
 If (SumValue > 0) Then
     rng.Select
     rng.Copy
     'put your next action
 Else
     'put your next action
 End If
Next iCol

End Sub

VBA根据条件从工作表复制到另一个

1 个答案: