I'm writing a macro that cycles through rows in a given named range, copies each individual row, and pastes them in another workbook. I can't copy the entire range for formatting reasons. The number of rows that have contents in them changes, as the macro also cycles through a list of files to pull these values from.
I created a counter variable i, that starts off as i=1. What I want to do is to have VBA first look at the named range, and select row 1 of it. Then if it contains contents, copy and paste them, and then set i 1. Back at the top, i = 2, and the macro selects row two in the named range, and runs it through the check.
I am very new to VBA and am struggling to generate the code to express this section.
CodePudding user response:
Copy Named Range Rows
- I would handle this by using a
For Each...Next
loop and by usingUnion
to combine each critical row into a multi-range. Then I would copy the complete range in one go. Here's a basic example.
Option Explicit
Sub CopyNamedRangeRows()
' Constants
' Source
Const sName As String = "Sheet1"
Const srgName As String = "MyRange"
Const scCol As Long = 1 ' Criteria Column
' Destination
Const dName As String = "Sheet2"
Const dFirst As String = "A2"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(srgName)
Dim scrg As Range ' Source Copy Range
Dim srrg As Range ' Source Row Range
For Each srrg In srg.Rows
If Len(CStr(srrg.Cells(scCol).Value)) > 0 Then
If scrg Is Nothing Then
Set scrg = srrg
Else
Set scrg = Union(scrg, srrg)
End If
End If
Next srrg
If scrg Is Nothing Then
MsgBox "No rows found", vbExclamation
Exit Sub
End If
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dCell As Range: Set dCell = dws.Range(dFirst)
scrg.Copy dCell
' Finishing Touches
MsgBox "Done.", vbInformation
End Sub
If you could share the code where this needs to fit, it surely could be adapted, or even better, a function to reference the critical rows (range) could be created.
To be able to use a counter variable you could replace
For Each srrg In srg.Rows
with...Dim i As Long For i = 1 To srg.Rows.Count Set srrg = srg.Rows(i)
... and replace
Next srrg
with...Next i
CodePudding user response:
Try the following code:
Sub copyRange(namedRange As Range)
Dim rng As Range
For Each rng In namedRange
'checking that the range is not empty
If rng <> "" Then
'copy it to your destination
rng.Copy anotherWB.yourdestinationWS.Range("A1")
End If
Next rng
End Sub
Sub test()
Dim myRange As Range
Set myRange = ActiveSheet.Range("A1:C5")
Call copyRange(myRange)
End Sub
If you need to copy the whole row, I can update the code.