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.:grinhalo: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