How do I reference a specific, changing row in a named range based on the value of a counter variabl-CodePudding

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 using Union 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.