1
votes

How do I transfer data from a worksheet to another based on a specific cell value? I tried several different VBA codes but I must be honest; I only have basic knowledge of VBA codes.

The case is, I have one worksheet, which is a register of a lot of information, and I want to transfer specific data from each row based on one specific cell value in the same row.

For example in Column L, I have the option via a dropdown menu to select "Yes - Urgent", "Yes" and "No". If it is "Yes - Urgent" or "Yes", I want it to automatically transfer some of the data to two separate worksheets. For example cell A, C, E and G of the same row that has "Yes" and transferred to B, D, E and F in a separate worksheet.

FYI, in the Excel workbook there is headers in all worksheets with filters. It's the filters that's bugging me specifically. I use Microsoft Office 2010.

1
Actually this kind of question has been asked here 1000 times. So you should be able to find a similar answer. Please show what exactly you have tried and where exactly you had errors or got stuck.Pᴇʜ
I saw a question yesterday that had almost exactly the same words in it's title as @Pᴇʜ suggested. Please do your investigation and you will find the answerZac

1 Answers

1
votes

I believe something like this will work:

'declaring variables
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim sheet3 As Worksheet
Dim new_row As Long

'setting sheets
Set sheet1 = ThisWorkbook.Sheets("Sheet 1")
Set sheet2 = ThisWorkbook.Sheets("Sheet 2")
Set sheet3 = ThisWorkbook.Sheets("Sheet 3")

'loop (starts at row 2 because of headers)
For Each cell In sheet1.Range(sheet1.Cells(2, 12), sheet1.Cells(Rows.Count, 12).End(xlUp))
    If cell.Value = "Yes - Urgent" Or cell.Value = "Yes" Then
        'first empty cell in sheet 2 (assuming column A always has a value)
        new_row = sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        'sheet1-A to sheet2-B
        sheet2.Cells(new_row, 2) = sheet1.Cells(cell.Row, 1)
        'sheet1-C to sheet2-D
        sheet2.Cells(new_row, 4) = sheet1.Cells(cell.Row, 3)
        'sheet1-E to sheet2-E
        sheet2.Cells(new_row, 5) = sheet1.Cells(cell.Row, 5)
        'sheet1-G to sheet2-F
        sheet2.Cells(new_row, 6) = sheet1.Cells(cell.Row, 7)
    ElseIf cell.Value = "No" Then
        'first empty cell in sheet 3 (assuming column A always has a value)
        new_row = sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        'sheet1-A to sheet3-B
        sheet3.Cells(new_row, 2) = sheet1.Cells(cell.Row, 1)
    End If
Next cell