[VBA] Δημιουργία Μορφοποιημένου Φύλλου Εργασίας με κώδικα

[Tasos]

Γεια σου Δημήτρη!
Μετονόμασε το φύλλο "ΠΡΟΣΦΟΡΑ" σε "OfferTemplate" και απόκρυψε το.

Κατόπιν στο φύλλο "ΥΠΟΛΟΓΙΣΜΟΣ ΠΡΟΣΦΟΡΑΣ" αντιστοίχησε την ρουτίνα "NewOffer" στον παρακάτω κώδικα σε ένα κουμπί:

Option Explicit
Const ilegalChars = ":\/?*[]"

Sub NewOffer()
    Dim rng As Range, Wks As Worksheet, NewWks As Worksheet, _
        xPos As Integer, OfferName As String, SheetName As String
    Application.ScreenUpdating = False
    OfferName = VBA.InputBox("Δώσε Eπωνυμία", "Νέα προσφορά...")
    If StrPtr(OfferName) = 0 Then Exit Sub
    SheetName = CleanName(OfferName)
    xPos = NewSheetPosition(NewName:=SheetName)
    Set Wks = ActiveSheet
    Wks.Range("A:E").AutoFilter Field:=3, Criteria1:=">0", _
                                Operator:=xlAnd

    With ThisWorkbook.Worksheets("OfferTemplate")
        .Visible = xlSheetVisible
        .Copy After:=Sheets(xPos)
        .Visible = xlSheetHidden
    End With
    Set NewWks = ActiveSheet
    Set rng = Wks.AutoFilter.Range.Offset(1)
    rng.Copy
    With NewWks
        .Name = SheetName
        .Range("B1") = OfferName
        .Range("A5").PasteSpecial xlPasteValues
        .Range("A5").Select
    End With
    Wks.AutoFilterMode = False
    Application.CutCopyMode = False

End Sub

Function NewSheetPosition(NewName As String) As Integer
    Dim sh As Object, i As Integer
    For Each sh In ThisWorkbook.Sheets
        If sh.Name = NewName Then
            Application.DisplayAlerts = False
            sh.Delete
            Application.DisplayAlerts = True
        Else
            If sh.Visible Then i = i + 1
        End If
    Next
    NewSheetPosition = i
End Function

Function CleanName(strName As String) As String
    Dim i As Integer, tmpName As String
    tmpName = strName
    For i = 1 To Len(ilegalChars)
        tmpName = Replace(tmpName, Mid(ilegalChars, i, 1), "_")
    Next
    CleanName = tmpName
End Function

Καλή συνέχεια!

Τάσος