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.

 

[Steves73]

Hi Joe

Mate, one more quick question,

Same code, but is it possible to have the code reference a cell in the worksheet where I can write the word "Reorder" instead on having to write it in the code? That way if I ever change the word "Reorder" to something else, the code will reference the new word and look for it in the same column

 

[Joe4]

Try this:

Sub MyCopy()

    Dim myStatus As String
    Dim lastRow As Long
    Dim myRow As Long
    Dim myCopyRow As Long
    
'   Get status from cell Z1 on sheet 1
    myStatus = Sheets("Sheet1").Range("Z1")
    
'   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") = myStatus 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 again mate

Works exactly how I want it

 

[Grub88]

Hi,
I've used this same code in my current spreadsheet (wanting to do the same thing - copy cells from one sheet to another based on the value in one column being 'active'). It works a treat BUT only copies the columns A and B. The rest are 'out of sync' e.g. Column 'Z' from the original sheet needs to go to column 'C' in the 2nd sheet. Any clues on how I can fix this? I've copied the code I tried below.

Sub Gen_Active()

Dim lastRow As Long
Dim myRow As Long
Dim myCopyRow As Long

' Set initial row to copy to as 4
myCopyRow = 4

' Find last row with data in column A on sheet 1
lastRow = Sheets("Year 1").Cells(Rows.Count, "Z").End(xlUp).Row

Application.ScreenUpdating = False

' Loop through all rows in Year 1
For myRow = 3 To lastRow
If Sheets("Year 1").Cells(myRow, "Z") = "Active" Then
Sheets("2018 Active").Cells(myCopyRow, "A") = Sheets("Year 1").Cells(myRow, "A")
Sheets("2018 Active").Cells(myCopyRow, "B") = Sheets("Year 1").Cells(myRow, "B")
Sheets("2018 Active").Cells(myCopyRow, "Y") = Sheets("Year 1").Cells(myRow, "C")
Sheets("2018 Active").Cells(myCopyRow, "Z") = Sheets("Year 1").Cells(myRow, "D")
Sheets("2018 Active").Cells(myCopyRow, "AA") = Sheets("Year 1").Cells(myRow, "E")
Sheets("2018 Active").Cells(myCopyRow, "AB") = Sheets("Year 1").Cells(myRow, "F")
Sheets("2018 Active").Cells(myCopyRow, "AC") = Sheets("Year 1").Cells(myRow, "G")
Sheets("2018 Active").Cells(myCopyRow, "AD") = Sheets("Year 1").Cells(myRow, "H")
Sheets("2018 Active").Cells(myCopyRow, "AE") = Sheets("Year 1").Cells(myRow, "I")
' Increment row counter
myCopyRow = myCopyRow + 1
End If
Next myRow

Application.ScreenUpdating = True

End Sub

 

[Grub88]

So I just realised I had my sheets mixed up... and now it's working.. and I can't figure out how to delete my previous post/comment. Very new to all of this.

 

[Grub88]

Me again... I've amended the code above to suit my purpose and it's working fine.
I now want to run the same 'code' for multiple sheets. I am copying the same columns from each sheet (A, B, Y, Z, AA, AB, AC, AD, AE) based on the Z value='Active'
There are 7 sheets in total ("Prep", "Year 1", "Year 2", "Year 3", "Year 4", "Year 5", "Year 6"). And I want them to copy into the sheet "2018 Active" into columns A, B, C, D, E, F, G, H, I.
I tried copying the same code underneath and changing "Year 1" to "Year 2" but it only brought back the year 1 data.

I haven't worked with this type of code before and am not sure of what most of it means to be able to problem solve.
I've pasted the amended code here...

Sub Gen_Active()

Dim lastRow As Long
Dim myRow As Long
Dim myCopyRow As Long

' Set initial row to copy to as 4
myCopyRow = 4

' Find last row with data in column A on sheet 1
lastRow = Sheets("Year 1").Cells(Rows.Count, "Z").End(xlUp).Row

Application.ScreenUpdating = False

' Loop through all rows in Year 1
For myRow = 3 To lastRow
If Sheets("Year 1").Cells(myRow, "Z") = "Active" Then
Sheets("2018 Active").Cells(myCopyRow, "A") = Sheets("Year 1").Cells(myRow, "A")
Sheets("2018 Active").Cells(myCopyRow, "B") = Sheets("Year 1").Cells(myRow, "B")
Sheets("2018 Active").Cells(myCopyRow, "Y") = Sheets("Year 1").Cells(myRow, "C")
Sheets("2018 Active").Cells(myCopyRow, "Z") = Sheets("Year 1").Cells(myRow, "D")
Sheets("2018 Active").Cells(myCopyRow, "AA") = Sheets("Year 1").Cells(myRow, "E")
Sheets("2018 Active").Cells(myCopyRow, "AB") = Sheets("Year 1").Cells(myRow, "F")
Sheets("2018 Active").Cells(myCopyRow, "AC") = Sheets("Year 1").Cells(myRow, "G")
Sheets("2018 Active").Cells(myCopyRow, "AD") = Sheets("Year 1").Cells(myRow, "H")
Sheets("2018 Active").Cells(myCopyRow, "AE") = Sheets("Year 1").Cells(myRow, "I")
' Increment row counter
myCopyRow = myCopyRow + 1
End If
Next myRow

Application.ScreenUpdating = True

End Sub​

 

[Joe4]

Are there exactly 8 sheets in your workbook ("2018 Active" and the other 7 you mentioned)?
Or are there other sheets in it too?

 

[Joe4]

Are there exactly 8 sheets in your workbook ("2018 Active" and the other 7 you mentioned)?

If this is true, this code should work:

Sub Gen_Active()

    Dim lastRow As Long
    Dim myRow As Long
    Dim myCopyRow As Long
    Dim ws As Worksheet

'   Set initial row to copy to as 4
    myCopyRow = 4

    Application.ScreenUpdating = False

'   Loop through all sheets
    For Each ws In Worksheets
'       Exclude "2018 Active" sheet
        If (ws.Name <> "2018 Active") Then
'           Find last row with data in column Z on sheet
            lastRow = ws.Cells(Rows.Count, "Z").End(xlUp).Row
'           Loop through all rows if row Z is set to Active
            For myRow = 3 To lastRow
                If ws.Cells(myRow, "Z") = "Active" Then
                    Sheets("2018 Active").Cells(myCopyRow, "A") = ws.Cells(myRow, "A")
                    Sheets("2018 Active").Cells(myCopyRow, "B") = ws.Cells(myRow, "B")
                    Sheets("2018 Active").Cells(myCopyRow, "Y") = ws.Cells(myRow, "C")
                    Sheets("2018 Active").Cells(myCopyRow, "Z") = ws.Cells(myRow, "D")
                    Sheets("2018 Active").Cells(myCopyRow, "AA") = ws.Cells(myRow, "E")
                    Sheets("2018 Active").Cells(myCopyRow, "AB") = ws.Cells(myRow, "F")
                    Sheets("2018 Active").Cells(myCopyRow, "AC") = ws.Cells(myRow, "G")
                    Sheets("2018 Active").Cells(myCopyRow, "AD") = ws.Cells(myRow, "H")
                    Sheets("2018 Active").Cells(myCopyRow, "AE") = ws.Cells(myRow, "I")
'                   Increment row counter
                    myCopyRow = myCopyRow + 1
                End If
            Next myRow
        End If
    Next ws

    Application.ScreenUpdating = True

End Sub

 

[Grub88]

No, there are 9 worksheets that are actively used each year. One for each grade level (Prep to Yr 6 so 7 of those in total - these are the ones i'm wanting to take the data from) and 2 summary sheets "2018 Active" and "2018 Monitor". Once I got the 'active' macro working I was going to use the same one but change the 'search value' to 'monitor' and have it go to the "2018 Monitor" sheet.
At the end of each year the Yr 6 data as saved as "Year 6 201?" depending on the year. These sheets are hidden. There are currently 2 lots hidden and this will be added to each year.

We use the spreadsheet to summarise/collate all student data. We then assign a status of active/monitor/inactive. To date I have gone through manually and copied all the 'active' and 'monitor' entries (only selected columns not all) to a their respective worksheets. We can then use these worksheets to prioritise students etc.

 

[Grub88]

I just tried this code. It only brought across columns A and B for the worksheet 'Year 1'.

I swapped the myCopyRow and myRow references (so A-I is the first column reference you come to when reading code left to right) which then copied all the data across as needed. But it still only did it for the 'Year 1' worksheet.

If this is true, this code should work:

Sub Gen_Active()

    Dim lastRow As Long
    Dim myRow As Long
    Dim myCopyRow As Long
    Dim ws As Worksheet

'   Set initial row to copy to as 4
    myCopyRow = 4

    Application.ScreenUpdating = False

'   Loop through all sheets
    For Each ws In Worksheets
'       Exclude "2018 Active" sheet
        If (ws.Name <> "2018 Active") Then
'           Find last row with data in column Z on sheet
            lastRow = ws.Cells(Rows.Count, "Z").End(xlUp).Row
'           Loop through all rows if row Z is set to Active
            For myRow = 3 To lastRow
                If ws.Cells(myRow, "Z") = "Active" Then
                    Sheets("2018 Active").Cells(myCopyRow, "A") = ws.Cells(myRow, "A")
                    Sheets("2018 Active").Cells(myCopyRow, "B") = ws.Cells(myRow, "B")
                    Sheets("2018 Active").Cells(myCopyRow, "Y") = ws.Cells(myRow, "C")
                    Sheets("2018 Active").Cells(myCopyRow, "Z") = ws.Cells(myRow, "D")
                    Sheets("2018 Active").Cells(myCopyRow, "AA") = ws.Cells(myRow, "E")
                    Sheets("2018 Active").Cells(myCopyRow, "AB") = ws.Cells(myRow, "F")
                    Sheets("2018 Active").Cells(myCopyRow, "AC") = ws.Cells(myRow, "G")
                    Sheets("2018 Active").Cells(myCopyRow, "AD") = ws.Cells(myRow, "H")
                    Sheets("2018 Active").Cells(myCopyRow, "AE") = ws.Cells(myRow, "I")
'                   Increment row counter
                    myCopyRow = myCopyRow + 1
                End If
            Next myRow
        End If
    Next ws

    Application.ScreenUpdating = True

End Sub