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
A few things to note:
Workbooks("Agent Stats Monthly.xlsm").Sheets("YourSheetWithData").Range("A" & Rows.Count).End(xlUp).Row
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
wsS.Range("A" & lRowS).Resize(1,5).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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.