Getting extra blank row when looping-CodePudding

This is my first time working with VBA, so hopefully this is something easy. I have code that loops through lines on one workbook, copies certain cells, and appends them into a second workbook. It keeps leaving an extra blank line at the end of the pasted data. I assume it has something to do with my for loop, but I have not found anything online that describes this problem.

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

CodePudding user response：

Copy Discontinuous Row Ranges

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

CodePudding user response：

A few things to note:

If you use .Offset(row,col) , you don't need to use i in your For each loop (albeit more useful to just use a normal for loop
Your lastrow is probably better obtained by

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

You shouldn't use Select to copy/paste: see: Avoid Select in VBA
You don't need to use copy/paste in your example, you can just set the values
You don't need to activate a workbook to change values in its sheets
PasteSpecial as what? Usually used to get rid of formulas with PasteSpecial xlPasteValues

I know those are a lot of "negatives" but this is meant as helpful criticism. You're doing far better than when I started with vba :)

The reason why you're getting an extra empty row is likely due to the starting value of your 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
        Dim colCount As Long: colCount = 0
        Dim areaR
        For Each areaR In Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Areas
            colCount = colCount   areaR.Columns.Count
        Next areaR
        wsS.Range("A" & lRowS).Resize(1,colCount).Value = Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Value
    End If
Next agentRow

Hope I didn't forget anything and used the resizing correctly, I'm still learning myself and unable to test right now.. If anything is unclear, feel free to ask, I'll answer in the morning.

**EDIT: ** Just noticed I did the resizing wrong when reading VBasic's answer, didn't noticed it was a continued range D:R, etc. My apologies. I adjusted my code but it's seeming less elegant now compared to VBasic's code. I do hope however that you can learn from both our code as is the point of this site.