CODEWITHSUNDEEP
excelvba
BluGeni
BluGeni

Reputation: 3454

Use VBA in Excel to print rows on different worksheet

I have three separate worksheets in a workbook that contain thousands of rows of information and new information is added frequently. I would like to be able to create separate reports using macros and VBA to print onto another worksheet when I need the report.

example

For example, report one would include all completed jobs in 2014. If Completed? equals YES and Year equals 2014, print entire row on blank worksheet. However, I need to use VBA so it goes through three worksheets and prints them all together in a separate worksheet. How would I do this?

Clarification: Basically if these two cells equal this and this, print the row on a different sheet.

Upvotes: 0

Views: 3943

Answers (1)

Davesexcel
Davesexcel

Reputation: 6982

Practice with this. Insert a button or some other type of object on the sheet with the data.

Once clicked the code will delete all the sheets except the active sheet.

It then loops through column A and creates the sheets. Then it loops through the sheets and filters your data sheet, copies and pastes the data into the sheet and moves on to the next sheet.

Sub getSht()
    Dim c As Range, sh As Worksheet
    Dim Rws As Long, Rng As Range, fRng As Range
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then sh.Delete
    Next sh
    With ws
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
        For Each c In Rng.Cells
            If WorksheetExists(c.Value) Then
            Else: Sheets.Add.Name = c
            End If
        Next c
    End With
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            ws.Range("A:A").AutoFilter Field:=1, Criteria1:=sh.Name
            Set fRng = ws.Range(ws.Cells(1, "A"), ws.Cells(Rws, "D"))
            fRng.Copy Destination:=sh.Range("A1")
        End If
        ws.AutoFilterMode = 0
    Next sh
    ws.Activate
End Sub


Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function

Upvotes: 2

Related Questions