Copy 3 worksheets to new workbook - 1 with visible cells only - the other 2 with values only

Question

I'm new here and to vba in general. I basically just read myself into the matter for my new job. So please bear with me. I'm looking for a solution to my issue and found seperate solutions for parts but I'm not able to piece them together.

My goal is the following: Copy 3 Worksheets of a workbook to a new one (not existing yet) and save it under the current date with a specific name. Here's the code that I put together so far for that which works fine.

Sub export()

Dim path As String
Dim file As String
Dim ws As Worksheet
Dim rng As Range

path = "D:\@Inbox\"
file = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " &     "accr " & Format(DateSerial(Year(Date), Month(Date), 1), "YYYY_MM") & " city" & ".xlsx"

Application.ScreenUpdating = False

Sheets(Array("Accr", "Pivot", "Segments")).Select
Sheets(Array("Accr", "Pivot", "Segments")).Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

For Each ws In Worksheets
ws.Rectangles.Delete
Next
Sheets(Array("Pivot", "Segments")).Visible = False

ActiveWorkbook.SaveAs Filename:=path & file, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close

Sheets("Menu =>").Select
Range("C1").Select

End Sub

1st condition: the new workbook should not be created manually and opened first, but the macro should do that.

2nd condition: the 1st workbook should have autofilters selected and then only visible cells copied. Is that possible as a whole worksheet, or do I have to copy the cells and create a worksheet in the new workbook? Here's the code for the filter

Sheets("Accr").Select
Reset_Filter
Selection.AutoFilter Field:=1, Criteria1:="12"
Selection.AutoFilter Field:=2, Criteria1:="booked"
Selection.AutoFilter Field:=35, Criteria1:="Frankfurt"
Set rng = Application.Intersect(ActiveSheet.UsedRange)
rng.SpecialCells(xlCellTypeVisible).Copy

3rd condition: the other two worksheets should be copied without formulas but with format. (That is included in the first code sample)

My problem is now, to piece everything together so that there are 3 worksheets in the new workbook containing in the first ws the visible cells of the source ws with the autofilter and the other two worksheets containing only the data and the format and being hidden. Info to my reasoning: the first worksheet refers with the formulas to the other two worksheets so that the recipients of the file have preselected fields and lists to fill out the cells.

Thank you very much in advance.

EDIT: Background Info: The Accr sheet contains accrual informattion and has the Month information in column A. Since several years should be also able to be compared in one Pivot Table later on, the format was changed from a mere number to a date (format: MM.YYYY).

Sorry for answering a bit late. It was hectic these days. To answer your questions: the autofilter is just for me to copy the correct data to export. The data consists of several lines per site which has to be sent to the responsible person. And they don't need to see the other information. And in that first sheet is only data, conditional formatting and formulas which go to the other two worksheets to help the people fill out the data with specific names to have consistent entries. — bbear

SilentRevolution SilentRevolution · Accepted Answer · 2016-01-14T13:46:55

Edit

Accr$vlookup=VLOOKUP(R2097;Segments!$G:$Q;11;0)Accr

Sub Export()
    Dim NewWorkbook As Workbook
    Dim Ws As Worksheet
    Dim fPath As String, fName As String
    Dim i As Long
    Dim RowsToDelete As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set NewWorkbook = Workbooks.Add

    fPath = "D:\@Inbox\"
    fName = VBA.Format(VBA.Date, "YYYY-MM-DD") & " " & VBA.Format(VBA.Time, "hhmm") & " " & "accr " & VBA.Format(VBA.DateSerial(VBA.Year(VBA.Date), VBA.Month(VBA.Date), 1), "YYYY_MM") & " city"

    NewWorkbook.SaveAs fPath & fName, xlOpenXMLWorkbook

    ThisWorkbook.Worksheets(Array("Accr", "Pivot", "Segments")).Copy NewWorkbook.Worksheets(1)

    For Each Ws In NewWorkbook.Worksheets
        With Ws
            If Not .Name = "Accr" And Not .Name = "Pivot" And Not .Name = "Segments" Then
                .Delete
            ElseIf Ws.Name = "Accr" Then
                For i = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    If Not .Cells(i, 1) = .Cells(i, 1) = Month(ThisWorkbook.Worksheets("Mon").Cells(19, 2)) And Not .Cells(i, 2) = "booked" And Not .Cells(i, 35) = "Frankfurt" Then
                        If RowsToDelete Is Nothing Then
                            Set RowsToDelete = .Rows(i).EntireRow
                        Else
                            Set RowsToDelete = Union(RowsToDelete, .Rows(i).EntireRow)
                        End If
                    End If
                Next i
                If Not RowsToDelete Is Nothing Then
                    RowsToDelete.Delete xlUp
                End If
            ElseIf .Name = "Pivot" Or .Name = "Segments" Then
                .Visible = xlSheetHidden
                .UsedRange = Ws.UsedRange.Value
            End If
        End With
    Next Ws

    NewWorkbook.Save
    NewWorkbook.Close

    Application.Goto ThisWorkbook.Worksheets("Menu =>").Cells(1, 3)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Copy 3 worksheets to new workbook - 1 with visible cells only - the other 2 with values only

2 Answers

Edit

End of edit