VBA Macro to copy and paste certian cells to another sheet based on another cell value

[Steves73]

hello

I am very new to VBA, I have been searching for weeks now for a easy macro to copy values from certain cells and paste them to another sheet based on another cell value

Example - Macro to search column "O" if it finds the word "Reorder" it copies cells A1, A2, A4, and paste the values to Sheet 3, starting in column A. The paste finds the next blank cell.

 

[Joe4]

Welcome to the Board!

What is the sheet name containing the column O you are searching?
So, are you saying that no matter what row "Reorder" is found in, you are going to copy cells A1, A2 and A4?
Are they being pasted in column A going down, or in columns A, B, and C?

 

[Steves73]

Hi Joe,

Thanks for the reply
Please see below in "red"

Welcome to the Board!

What is the sheet name containing the column O you are searching? - Sheet 1
So, are you saying that no matter what row "Reorder" is found in, you are going to copy cells A1, A2 and A4? - Yes correct, also, once I see the code I have the option to change the reference column if possible.
Are they being pasted in column A going down, or in columns A, B, and C?

- Would like them copied and pasted to say Sheet 2 - Row 2

 

[Joe4]

Try this:

Sub MyCopy()

    Dim lastRow As Long
    Dim myRow As Long
    Dim myCopyRow As Long
    
'   Set initial row to copy to as 2
    myCopyRow = 2
    
'   Find last row with data in column D on sheet 1
    lastRow = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
'   Loop through all rows in sheet 1
    For myRow = 1 To lastRow
        If Sheets("Sheet1").Cells(myRow, "D") = "Reorder" Then
            Sheets("Sheet2").Cells(myCopyRow, "A") = Sheets("Sheet1").Range("A1")
            Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Range("A2")
            Sheets("Sheet2").Cells(myCopyRow, "C") = Sheets("Sheet1").Range("A4")
'           Increment row counter
            myCopyRow = myCopyRow + 1
        End If
    Next myRow
                  
    Application.ScreenUpdating = True
    
End Sub

 

[Steves73]

Hi Joe

Apologies, Probably didn't explain this very well

Below highlighted in red are the times I would need to be copied to Sheet 2 based on the word 'Reorder"

Part Name	Supplier	Department				4	8	5	3	5	Reorder
Part Name	Supplier	Department				4	8	6	2	6	Reorder
Part Name	Supplier	Department				3	6
Part Name	Supplier	Department				4	8	5	3	5	Reorder
Part Name	Supplier	Department				4	8
Part Name	Supplier	Department				4	8
Part Name	Supplier	Department				4	8	6	2	6	Reorder
Part Name	Supplier	Department				0	1

<tbody>
</tbody><colgroup><col span="2"><col><col span="9"></colgroup>

Part Name	Supplier	Department				4	8	5	3	5	Reorder
Part Name	Supplier	Department				4	8	6	2	6	Reorder
Part Name	Supplier	Department				3	6
Part Name	Supplier	Department				4	8	5	3	5	Reorder
Part Name	Supplier	Department				4	8
Part Name	Supplier	Department				4	8
Part Name	Supplier	Department				4	8	6	2	6	Reorder
Part Name	Supplier	Department				0	1

<tbody>
</tbody><colgroup><col span="2"><col><col span="9"></colgroup>

 

[Joe4]

I don't think that picture helps that much without a detailed explanation.
Can you build off the explanation have you given so far?
Was anything you mentioned earlier erroneous or incomplete?

 

[Steves73]

Ok, Basically the spread sheet is used to control warehouse stock, the spread sheet has all the items details in rows across the spreadsheet (Columns A - O) Each item has a quantity allocated to it, when I remove a items from stock the quantity reduces, once it reaches a certain level the sheet will place the word "Reorder" next to the line item.

What I need was a macro which search's the column that has the word 'Reorder" then copies and pastes the cells within the row instead of the entire row. Dependent on which row has the word "Reorder" the macro will move to that row, then copies cells, say A1, B1 and G1, then it looks at the next row in column "O" and if "Reorder" is found it copies A2, B2, and G2 and so on. if the row does not have the word "Reorder" it moves the next until it has checked all rows

 

[Joe4]

OK, so it is NOT always copying cells A1, A2, and A4.

If you always want to copy columns A, B, and G from the Reorder rows, try:

Sub MyCopy()

    Dim lastRow As Long
    Dim myRow As Long
    Dim myCopyRow As Long
    
'   Set initial row to copy to as 2
    myCopyRow = 2
    
'   Find last row with data in column D on sheet 1
    lastRow = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
'   Loop through all rows in sheet 1
    For myRow = 1 To lastRow
        If Sheets("Sheet1").Cells(myRow, "D") = "Reorder" Then
            Sheets("Sheet2").Cells(myCopyRow, "A") = Sheets("Sheet1").Cells(myRow, "A")
            Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Cells(myRow, "B")
            Sheets("Sheet2").Cells(myCopyRow, "G") = Sheets("Sheet1").Cells(myRow, "G")
'           Increment row counter
            myCopyRow = myCopyRow + 1
        End If
    Next myRow
                  
    Application.ScreenUpdating = True
    
End Sub

 

[Steves73]

Thanks mate

Works perfectly

Thanks you very much for your help

 

[Joe4]

You are welcome!