I need to copy and paste a dynamic range of rows into a hard-coded position within the same workbook. A row will be copied based on conditional logic. The logic is, essentially, if this specific cell's value = Law, then take that row and the column that is offset to the right by 5 places, and paste that into a specific range. The issue I am running into is that my logic is only copying and pasting one column and pasting it into the designated range, however, each additional row in my For Each loop overwrites the previous value that existed. Furthermore, my code is not copying beyond the first column, the second column is ignored when I also want those values to be copied as well. I need each newly added row to be pasted into the next empty cell. Below is the logic that I am currently working with:

    Dim start_range As Range
    Set start_range = ws.Range("A2")
    Dim end_range As Range
    ws.Activate
    start_range.End(xlDown).Select
    Set end_range = ActiveCell
    Dim total_range As Range
    Set total_range = Range(start_range, end_range)
    For Each x In total_range
        If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
            x.Copy ws.Range("A10")
            x.Offset(5, 0).Copy ws.Range("B10")
            
        End If
    Next

The topmost columns of the attached image display the data source I would pull from, and the bottom displays the result that I would like to see based on cleaning up my code. Let me know if any further clarification is needed.

I previously tried adding an additional For Each loop that would take the second column that I needed, however, that does not seem efficient, and I feel like the transaction can be completed within the same For Each loop, however, I am stumped as to how to achieve that.

Updated code (still needs tweaking) via Toddleson

Dim wb As Workbook
Set wb = ThisWorkbook
Dim start_range As Range
Set start_range = wb.Sheets(1).Range("A2")
Dim end_range As Range
Set end_range = start_range.End(xlDown)
Dim total_range As Range
Set total_range = wb.Sheets(1).Range(start_range, end_range)
For Each x In total_range
    If x.Value = "Law School Debt/Loan." Or x.Value = "Law" Then
        x.Copy wb.Sheets(1).Cells(10   Count, 1)
        Count = Count   1
        x.Offset(0, 5).Copy wb.Sheets(1).Cells(2, 10   Count, 1)
        
    End If
Next

CodePudding user response：

Copy Data Based on Condition (For Each...Next)

Option Explicit

Sub CopyFilteredData()

    ' Workbook, Worksheet
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")

    ' Source

    ' Source Range (has headers)
    ' (the resize part means include only first 6 columns)
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion ' .Resize(, 6)
    ' Source Data Range (data without headers)
    Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)

    ' Destination

    ' Destination First Cell (the 3 means 4 rows below the last row)
    Dim dfCell As Range: Set dfCell = srg.Cells(1).Offset(srg.Rows.Count   3)
    ' To copy to another worksheet instead you could e.g. do:
    'Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    'Dim dfCell As Range: Set dfCell = dws.Range("A2")
     
    ' Loop and copy.
    
    Dim rrg As Range ' Current Row (Range)

    ' Loop through the rows of the data range (no headers).
    For Each rrg In sdrg.Rows
        Select Case CStr(rrg.Cells(1).Value) ' 'CStr' also avoids errors
        Case "Law School Debt/Loan.", "Law" ' the comma means 'Or'
            rrg.Copy dfCell ' copy row and paste starting with 'dfCell'
            Set dfCell = dfCell.Offset(1) ' reference the (next) cell below
        End Select
    Next rrg

    ' Inform.

    MsgBox "Filtered data copied.", vbInformation

End Sub

CodePudding user response：

You're doing Offset(5,0) which is taking the cell 5 rows below x. If you're trying to get 5 columns beside x you need Offset(0,5)

If you want the cells to not overwrite each other then you can't have "A10" and "B10" written as static values. You need to add some counter or variable that will move the address whenever values are pasted. Try changing the "A10" line into x.Copy ws.Cells(10 Count, 1) and then do Count = Count 1 after the copy pasting. Also change the "B10" line, of course.

Sub Example()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)
    
    Dim start_range As Range
    Set start_range = ws.Range("A2")
    
    Dim end_range As Range
    Set end_range = start_range.End(xlDown)
    
    Dim total_range As Range
    Set total_range = ws.Range(start_range, end_range)
    
    Dim Cell As Range, Count As Long
    For Each Cell In total_range.Cells
        If Cell.Value = "Law School Debt/Loan." Or Cell.Value = "Law" Then
            Cell.Copy ws.Cells(10   Count, 1)
            Cell.Offset(0, 5).Copy ws.Cells(10   Count, 2)
            Count = Count   1
        End If
    Next
End Sub