Copy Paste Cell Values - If InString to Different Worksheets

[dj44]

folks,
Good weekend,



I am trying to copy and paste some data from different worksheets into different worksheets.


I made the setup and something worked but at a basic level and then I added some more variables and made it into a multidimensional array I think.

So now it's not working.

  Sub Copy_Data()

    Dim i  As Long
    Dim ws  As Worksheet
    Dim oOriginalSearchWS    As Worksheet
    Dim oDestinationSheet   As Worksheet

    Set ws = Worksheets("Table")

   ' Search this worksheet
    For i = 2 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    Set oOriginalSearchWS = Worksheets(ws.Cells(i, "B").Value)           ' Search this worksheet

    ' Send to these worksheet
    Set oDestinationSheet = Worksheets(ws.Cells(i, "E").Value)

    ' if column d values are found in column c ranges

    If InStr(1, oOriginalSearchWS.Range(ws.Cells(i, "C")).Value, ws.Cells(i, "D").Value) > 0 Then



    'Copy paste the data
    oOriginalSearchWS.Range(ws.Cells(i, "C")).Copy _
    Destination:=oDestinationSheet.Range(ws.Cells(i, "F").Value)    ' Paste Location

      End If
      Next i
End Sub

I tried a lot fo autofiltering this week but i had to do it one by 1 so now i have made a table to find these strings and copy and paste them.

I also didnt know how to increment the row loop counter ?
If somebody could take a look at my workbook to see where the set-up has gone i'll be really grateful.

thanking you very much for your time

[mdmackillop]

Something like this. You can't use Instr on a range.
Personally I would use a filter on the selected data.

Option Explicit


  Sub Copy_Data()


    Dim i  As Long, j As Long
    Dim cel As Range
    Dim ws  As Worksheet
    Dim oOriginalSearchWS    As Worksheet
    Dim oDestinationSheet   As Worksheet


    Set ws = Worksheets("Table")
   ' Search this worksheet
    For i = 2 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        j = 1
        Set oOriginalSearchWS = Worksheets(ws.Cells(i, "B").Value)           ' Search this worksheet
        ' Send to these worksheet
        Set oDestinationSheet = Worksheets(ws.Cells(i, "E").Value)
        ' if column d values are found in column c ranges
        For Each cel In oOriginalSearchWS.Range(ws.Cells(i, "C").Value)
            If InStr(1, cel, ws.Cells(i, "D").Value) > 0 Then
                'Copy paste the data
                j = j + 1
                cel.Copy oDestinationSheet.Cells(j, "F")    ' Paste Location
            End If
        Next
        
    Next i
End Sub

[dj44]

Hello M,

I cant thank you enough the dread i have looking at data makes me want to run a million mile an hour, if only my fitness was on par.thats some
thing i need to exercise too.

This week's my brain has been pounded with autofilter from every angle and I'm none the wiser .

I also tried Vlook up but that was another story - and messy with the cell quotation mark.

And I tried so many things to try and extract some strings from some data but it just wouldn't be extracted the way that I needed it and I ended up making data soup with my attempts.

This is a lifesaver now really thank you so much

Thanks for lending your expert coding skills - this is wizadry - it is to me any way becuase i spent the whole week trying to make this work.

I hope you have a fantastic weekend

thanks again

thanks a lot folks and forum

[mdmackillop]

Happy to help.

Sub Copy_Data()
    Dim i  As Long
    Dim ws  As Worksheet
    Dim oOriginalSearchWS    As Worksheet
    Dim oDestinationSheet   As Worksheet
    Dim r As Range, s As Range
    
    Set ws = Worksheets("Table")
    For i = 2 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set oDestinationSheet = Worksheets(ws.Cells(i, "E").Value)
    Set oOriginalSearchWS = Worksheets(ws.Cells(i, "B").Value)           ' Search this worksheet
    
    Set r = oOriginalSearchWS.Range(ws.Cells(i, "C"))
    With r
        .AutoFilter Field:=1, Criteria1:="=" & ws.Cells(i, "D")
        Set s = .Offset(1).Resize(r.Count - 1)
        s.Copy oDestinationSheet.Cells(Rows.Count, "F").End(xlUp)(2)
        .AutoFilter
    End With
    Next i
End Sub