Copy and paste specific cells between Workbooks based on criteria

[GEO81]

Hello!

I have a little experience with VBA and from time to time i have created my own macros.
Now i need something a little bit more complicated and even though i read quite a lot of examples, i could find something matching to my requirements.

So here is what I'm trying to achieve:

Consider Workbook "Source" with two worksheets: "Info1" and ""Info1" which have data in columns from A to Z. [all worksheets have the same headers].
Another Workbook "Destination" with worksheet "Data" to which I want to paste my selected values from Workbook "Source".

My requirement is to find the Rows in Workbook "Source" - search at all worksheets - which in Column R the values is equal to "X001".
Then copy from those Rows only the values of cells at columns R and W and paste to the other Workbook "Destination" at Row 2 Column A and B (Row 1 has headers.)

Just to let you know that both Workbooks will be open when i would like to run the macro.

Any idea is more that welcome!

Thank you!

 

[gordsky]

Hello!

I have a little experience with VBA and from time to time i have created my own macros.
Now i need something a little bit more complicated and even though i read quite a lot of examples, i could find something matching to my requirements.

So here is what I'm trying to achieve:

Consider Workbook "Source" with two worksheets: "Info1" and ""Info1" which have data in columns from A to Z. [all worksheets have the same headers].
Another Workbook "Destination" with worksheet "Data" to which I want to paste my selected values from Workbook "Source".

My requirement is to find the Rows in Workbook "Source" - search at all worksheets - which in Column R the values is equal to "X001".
Then copy from those Rows only the values of cells at columns R and W and paste to the other Workbook "Destination" at Row 2 Column A and B (Row 1 has headers.)

Just to let you know that both Workbooks will be open when i would like to run the macro.

Any idea is more that welcome!

Thank you!

do you want all values from column R on the sheet that meet your criteria or just within a select range (you said at the start your selected values....?)

 

[GEO81]

Hello,
I want ''all values from column R on the sheet that meet my criteria". Which is actually the value "X001" since this the criteria.

 

[EFANYoutube]

Hi GEO81
Please try this code in the destination workbook. the source has to be open for it to work

Sub Getdata()
    Dim Source As Workbook
    Set Source = Workbooks("Source.xlsx")
    
    Dim Destination As Workbook
    Set Destination = ThisWorkbook
    
    Dim ListofValues As Collection
    
    Set ListofValues = New Collection
    Dim cell As Range
    Dim sht As Worksheet
    
    'Copy the data
    For Each sht In Source.Sheets
        For Each cell In sht.Range("R:R").Cells
            If cell.Value = "X001" Then
                ListofValues.Add cell.Value & "," & cell.Offset(, 5).Value
            End If
        Next cell
    Next sht
    
    Dim Valueset As Variant
    'Paste the data
    Dim RowNumber As Integer
    RowNumber = 2
    For Each Valueset In ListofValues
        Destination.Sheets(1).Cells(RowNumber, 1).Value = Split(Valueset, ",")(0)
        Destination.Sheets(1).Cells(RowNumber, 2).Value = Split(Valueset, ",")(1)
        RowNumber = RowNumber + 1
    Next Valueset
End Sub

 

[gordsky]

another option would be this

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim cel As range, MyRng As range
Dim i As Long, lrow As Long

Set wb1 = Workbooks("Source")
Set wb2 = Workbooks("Destination")
Set ws1 = wb2.Sheets("Data")
i = 2

For Each ws In wb1.Worksheets
    lrow = ws.Cells(Rows.count, 18).End(xlUp).Row
    Set MyRng = ws.range(ws.Cells(1, 18), ws.Cells(lrow, 18))
    
    For Each cel In MyRng
        If cel = "X001" Then
           ws1.range("A" & i) = cel
           ws1.range("B" & i) = cel.Offset(0, 5)
           i = i + 1
        Else
        End If
    Next cel
Next ws

 

[GEO81]

Hi GEO81
Please try this code in the destination workbook. the source has to be open for it to work

Sub Getdata()
    Dim Source As Workbook
    Set Source = Workbooks("Source.xlsx")
   
    Dim Destination As Workbook
    Set Destination = ThisWorkbook
   
    Dim ListofValues As Collection
   
    Set ListofValues = New Collection
    Dim cell As Range
    Dim sht As Worksheet
   
    'Copy the data
    For Each sht In Source.Sheets
        For Each cell In sht.Range("R:R").Cells
            If cell.Value = "X001" Then
                ListofValues.Add cell.Value & "," & cell.Offset(, 5).Value
            End If
        Next cell
    Next sht
   
    Dim Valueset As Variant
    'Paste the data
    Dim RowNumber As Integer
    RowNumber = 2
    For Each Valueset In ListofValues
        Destination.Sheets(1).Cells(RowNumber, 1).Value = Split(Valueset, ",")(0)
        Destination.Sheets(1).Cells(RowNumber, 2).Value = Split(Valueset, ",")(1)
        RowNumber = RowNumber + 1
    Next Valueset
End Sub

Thank you EFANYoutube !

It is simple and worked like a charm! thanks a lot!

 

[GEO81]

another option would be this

Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim cel As range, MyRng As range
Dim i As Long, lrow As Long

Set wb1 = Workbooks("Source")
Set wb2 = Workbooks("Destination")
Set ws1 = wb2.Sheets("Data")
i = 2

For Each ws In wb1.Worksheets
    lrow = ws.Cells(Rows.count, 18).End(xlUp).Row
    Set MyRng = ws.range(ws.Cells(1, 18), ws.Cells(lrow, 18))
   
    For Each cel In MyRng
        If cel = "X001" Then
           ws1.range("A" & i) = cel
           ws1.range("B" & i) = cel.Offset(0, 5)
           i = i + 1
        Else
        End If
    Next cel
Next ws

Thank you gordsky for your feedback!
However, I'm not familiar how i can use this code in excel formula. I just did some google search and i will try it for sure!
Thanks!