Conditional copy and paste excel vba

Question

I'm trying to copy and paste a certain value from a cell in one sheet matching a range in another workbook. The code runs fine, doesn't give any run-time errors, but will not paste in the range declared in the other workbook. Code below

Sub ConditionalCopy()
    Dim dest As Worksheet
    
    Set dest = ActiveWorkbook.Worksheets("VCP Plan")
    
    Dim rng As Range, cell As Range
    Set rng = Range("D:D")
    
    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Workbooks.Open (OpenWorkBook)
    End If
    For Each cell In rng
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=dest.Range("E3")
        End If
    Next cell            
End Sub

chris neilsen chris neilsen · Accepted Answer · 2020-08-21T01:02:12

It is unclear from your description and your code which workbook/worksheet you want to compare and copy, and which workbook/worksheet you want to copy to.

You'll need to be more specific

I've made a guess at what you are trying to do. If I've got it wrong, simply adjust the references to suit

Something like

Sub ConditionalCopy()
    Dim wbSource as Workbook
    Dim wsSource as Worksheet
    Dim rSource as Range
    Dim wbDest as Workbook
    Dim wsDest as Worksheet
    Dim rDest as Range

    Set wbDest = ActiveWorkbook ' Are you sure?
    Set wsDest = wbDest.Worksheets("VCP Plan")
    Set rDest = ws.Range("E3")

    Dim OpenWorkBook As Variant
    OpenWorkBook = Application.GetOpenFilename("Excel Files (*.xlsx* (*.xlsx*),")
    
    If OpenWorkBook <> False Then
        Set wbSource = Workbooks.Open(OpenWorkBook) 
    Else
        Exit Sub
    End If

    Set wsSource = wbSource.Worksheets("NameOfSourceSheet")

    Dim cell As Range
    With wsSource
        ' Column D from row 1 to last used row
        Set rSource = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    

    For Each cell In rSource
        If cell.Value = "26ASA00015D007" Then
            cell.Offset(0, 3).Copy Destination:=rDest
            ' You probably don't want to overwrite each time, so
            Set rDest = rDest.Offset(1, 0)
        End If
    Next cell            
End Sub

Conditional copy and paste excel vba

1 Answers