If Cell value is equal to, copy data from cells to other workbook

[RvdV16681]

Hello,

I'm setting up a macro for a button on a worksheet, worksheet 1 in workbook X. What I would like when this button is clicked, is to check all cells in column A for the word "Copy"
Next step is that if this word is found, another workbook, Y, is opend.
Finally if the word "Copy" was found for example in cell A9, I want the data that is in cell Q9, R9 and S9, so in the same row as where the word is found, to be copied and pasted to
cells M13, P13 and S13 of workbook Y sheet 1.

For the copy part it I think it has to work with selecting with a range of something, because it has to select the cells that are in the same row as where the word "Copy" was found
I made a first start, but I'm having trouble getting it to work and don't know how I can create the copy part as it should be

Hopefully someone here can help. Thank you in advance!!

Sub Copy_cells_to_Test_Report()

' Decleration
Dim x As Workbook
Dim y As Workbook
Dim row As Integer
    row = 1
        
    ' Sheet name where data is
    Sheets("Sheet1").Select


        ' Copy content if match found
        If Worksheets("Sheet1").Range("A" & row) = "Copy" Then
   
    'Open both workbooks first:
    Set x = Workbooks.Open("workbookX.xlsm ")     
    Set y = Workbooks.Open("workbookY.xlsm ")


    'Transfer values from x to y:
    y.Sheets("Sheet1").Range("M13").Value = x.Sheets("Sheet1").Range("R9")
    
    
  End If
  
End Sub

 

[RvdV16681]

I did some searching and I found something that maybe could work better form me. At least I now have the funtion to open the other workbook working, now the copy pasting part... And in this code it only copies one value so this needs to be adapted as well.

Sub Copy_cells_to_Test_Report()

Dim val As String
Dim result As String
Dim firstAddress As String
Dim c As Range
Dim FilePath As String
FilePath = "workbookY.xlsm"


    val = "Copy"
    Set c = Sheets("Sheet1").Range("A:A").Find(val, LookIn:=xlValues, MatchCase:=False)


    If Not c Is Nothing Then
        firstAddress = c.Address


        Do
            If Len(result) > 0 Then
                result = result & " and " & c.Offset(, 16).Text
            Else
                result = c.Offset(, 16).Text
            End If


            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If


    Workbooks.Open (FilePath)
    With Workbooks("WorkbookY.xlsm").Worksheets("Sheet1")
    Range("M13").Value = result
  
  End With
    
End Sub

 

[RvdV16681]

Did some more trying on the previous code and got it working for copying and pasting data from 1 cell. Only thing is that also the word "and" appiers along the data that
is pasted, don't know where this is coming from. Hopefully someone can help me to extend the copying and pasting over more cells at once.
Also the formatting of the copied cell should be pasted, hopefully this can be done all at once.

Sub Copy_cells_to_Test_Report()

Dim val As String, result As String, firstAddress As String, FilePath As String
Dim c As Range


FilePath = "workbookY.xlsm"


    val = "Copy"
    Set c = Sheets("Sheet1").Range("A:A").Find(val, LookIn:=xlValues, MatchCase:=False)


    If Not c Is Nothing Then
        firstAddress = c.Address


        Do
            If Len(result) > 0 Then
                result = result & " and " & c.Offset(, 16).Text
            Else
                result = c.Offset(, 16).Text
            End If


            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If


    Workbooks.Open (FilePath)
    With Workbooks("workbookY.xlsm").Worksheets("Sheet1")
    Range("M13").Value = result
  
  End With
    
End Sub

 

[RvdV16681]

Already found the problem why the word "and" appears. It simply is in the code... With that sorted out, also the formatting of the copied cell is pasted in the other workbook so also that
problem is taken care of. Now only thing is selecting and copying several cells in the row that has "Copy" in column A, and pasting them in the correct cell of the other workbook.