循環時獲取額外的空白行

Question

這是我第一次使用 VBA，所以希望這很容易。 我有代碼循環遍歷一個工作簿上的行，復制某些單元格，並將它們附加到第二個工作簿中。 它會在粘貼數據的末尾留下一個額外的空行。 我認為它與我的 for 循環有關，但我沒有在網上找到任何描述此問題的內容。

For Each agentRow In Range("A4:A45")
Workbooks("Agent.xlsx").Activate
    'Check to see if the agent is active this month
    If Range("D" & i).Value > 10 And Range("E" & i).Value > 10 Then
        'If so, copy this data
        Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Select
        Selection.Copy

        'Goto the workbook that will store the data
        Workbooks("Agent Stats Monthly.xlsm").Activate
    
        'Find the last row with data, then paste onto the next row
        findLastRow = 1 + Range("A:A").SpecialCells(xlCellTypeLastCell).Row

        Range("A" & findLastRow).PasteSpecial
    End If
i = i + 1
Next agentRow

Answer 1

有幾點需要注意：

• 如果您使用.Offset(row,col)，則無需在 For each 循環中使用 i（盡管使用普通的 for 循環更有用
• 你的 lastrow 可能更好地獲得

Workbooks("Agent Stats Monthly.xlsm").Sheets("YourSheetWithData").Range("A" & Rows.Count).End(xlUp).Row

• 您不應該使用 Select 來復制/粘貼：請參閱： Avoid Select in VBA
• 您不需要在示例中使用復制/粘貼，只需設置值即可
• 您無需激活工作簿即可更改其工作表中的值
• PasteSpecial 是什么？ 通常用於使用PasteSpecial xlPasteValues去除公式

我知道這些是很多“負面”，但這是有益的批評。 你比我開始使用 vba 時做得更好:)

你得到一個額外的空行的原因可能是由於你的起始值i

Workbooks("Agent.xlsx").Activate
Dim wbS As Workbook: Set wbS = Workbooks("Agent Stats Monthly.xlsm")
Dim wsS As Worksheet: Set wsS = wbS.Sheets("YourDataSheet")
Dim lRowS As Long
lRowS = wsS.Range("A" & Rows.Count).End(xlUp).Row
For Each agentRow In Range("A4:A45")
    i = agentRow.Row 'I'm assuming that agentRow is a Range object since it's in Range("A4:A45")
    'Check to see if the agent is active this month
    If Range("D" & i).Value > 10 And Range("E" & i).Value > 10 Then
        'If so, copy this data
        lRowS = lRowS+1 'only add +1 if you're going to add a row to your DataSheet
        wsS.Range("A" & lRowS).Resize(1,5).Value = Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Value
    End If
Next agentRow

希望我沒有忘記任何東西並正確使用調整大小，我還在學習自己，現在無法測試。如果有任何不清楚的地方，請隨時提問，我會在早上回答。

Answer 2

復制不連續的行范圍

Sub CopyAgentData()
     
    ' Source
    Dim swb As Workbook: Set swb = Workbooks("Agent.xlsx")
    Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1") ' adjust!
    Dim srg As Range: Set srg = sws.Range("D4:E45") ' read
    Dim scrg As Range: Set scrg = Intersect( _
        srg.Rows(1).EntireRow, sws.Range("A:A,D:R,U:Z")) ' copy (first row)
    
    ' Destination
    Dim dwb As Workbook: Set dwb = Workbooks("Agent Stats Monthly.xlsm")
    ' If this code is in this workbook, instead use:
    'Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1") ' adjust!
    Dim dfCell As Range: Set dfCell = dws.Range("A2")
    Dim dlCell As Range: Set dlCell = dws.UsedRange _
        .Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If Not dlCell Is Nothing Then
        If dfCell.Row <= dlCell.Row Then
            Set dfCell = dws.Cells(dlCell.Row + 1, dfCell.Column)
        End If
    End If
    
    ' Loop.
    
    Dim srrg As Range ' Current Read Row Range

    For Each srrg In srg.Rows
        'Check to see if the agent is active this month
        If srrg.Cells(1).Value > 10 And srrg.Cells(2).Value > 10 Then
            'If so, copy this data
            'Debug.Print srrg.Address, scrg.Address, dfCell.Address
            scrg.Copy dfCell
            Set dfCell = dfCell.Offset(1) ' next first destination cell
        End If
        Set scrg = scrg.Offset(1) ' next source copy row range
    Next srrg

End Sub