-4

Worksheet 'Data' consist of 4 columns - Year, Day, Month and Gender . I want to extract data to Worksheet 'Report' - Year and Gender. Data should be extracted upon input of Year. Can you please show me how to do it using Excel VBA code?

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Matthew
  • 41
  • 1
  • 8
  • My advice learn how to [Filter data in a range or table](https://support.office.com/en-us/article/filter-data-in-a-range-or-table-01832226-31b5-4568-8806-38c37dcc180e?ui=en-US&rs=en-US&ad=US) and give the Macro Recorder a try. – Pᴇʜ Mar 15 '19 at 14:08
  • Thanks PEH for your comments. Filter data will do the job on the worksheet 'Data' however I want data in another sheet with less information (less columns). This is just simple example, I will elaborate much more with my actual data file. I just need to know were to start. – Matthew Mar 15 '19 at 14:17
  • Start using the macro recorder, filter your data and copy the desired columns of the filter result to another sheet. Then read [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) and apply that to the code of your recorded macro. We cannot provide the code for you if you did nothing yet. – Pᴇʜ Mar 15 '19 at 14:20

1 Answers1

1

Try: Option Explicit

Sub test()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LastRow1 As Long, LastRow2 As Long, i As Long

    With ThisWorkbook

        'Set Worksheets
        Set ws1 = .Worksheets("Data")
        Set ws1 = .Worksheets("Report")

        'Find last row in Data
        LastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

        'Loop from row 2 to  last row
        For i = 2 To LastRow1
            'Test Year
            If ws1.Range("A" & i).Value = "2019" Then

                LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
                'Copy - Paste Year to ws2 at column A
                ws1.Range("A" & i).Copy ws2.Range("A" & LastRow2 + 1)
                'Copy - Paste Gender to ws2 at column B
                ws1.Range("D" & i).Copy ws2.Range("B" & LastRow2 + 1)

            End If

        Next i

    End With

End Sub
Error 1004
  • 7,877
  • 3
  • 23
  • 46
  • Thanks!.....great start! I will update code so that the criteria is an input and data is cleared upon each input. – Matthew Mar 15 '19 at 15:26
  • @user3693592 glad to hear that this code fulfill your needs. if the answer helps you mark it as the correct answer to help others with the same question. – Error 1004 Mar 15 '19 at 16:06