Engenharia Contratos INFRA.vba

Private Sub CommandButton2_Click()

Me.Hide


 Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Contratos-Região")
    
    Dim aCell As Range, Rng As Range
    Dim col As Long, lRow As Long
    Dim colName As String
    Dim dateHold As String
    Dim month As String
    Dim year As Integer
    Dim datadummy As String
    datadummy = Format(Now(), "yyyymmdd")
    
    Sheets("Contratos-Região").Select
    
    



    Dim i As Long, sh As Worksheet, shname As String
    Sheets("Contratos-Região").Copy Before:=Sheets(1)
    shname = InputBox("Digite um nome para a nova Planilha")
    For Each sh In Sheets
        If sh.Name = shname Or sh.Name Like shname & "*" Then i = i + 1
    Next
    If i = 0 Then
        ActiveSheet.Name = shname
    Else
        ActiveSheet.Name = shname & "-" & i
    End If

    
    
   
    
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
    
    
    
    'QUERY

    
    month = Me.mont
    year = Me.yr
    
    dateHold = "Valor " & month & "/" & (year - 2000)
    
 

    Sheets("Contratos-Região").Select
    
    
    
    
    
     With ws
        Set aCell = .Range("A6:DD6").Find(What:=dateHold, LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)

        'Found
        If Not aCell Is Nothing Then
            col = aCell.Column
            colName = Split(.Cells(, col).Address, "$")(1)

            lRow = .Range(colName & .Rows.Count).End(xlUp).Row

            'range
            Set Rng = .Range(colName & "6:" & colName & lRow)

            Debug.Print Rng.Address
        '404
        Else
            MsgBox "Not Found"
        End If
    End With
    
    Rng.Select
    

    Selection.Copy
    
    
    
    
    Sheets(shname).Select
    Range("G6").Select
    
    ActiveSheet.Paste
    Columns("G:G").EntireColumn.AutoFit
    
    Rows("6:6").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A6:G6").Select
    Range("G6").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    
    Rows("2:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Columns("A:A").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireRow.AutoFit
    Cells.Select
    ActiveWindow.SmallScroll Down:=-12
    Cells.EntireColumn.AutoFit
    Columns("A:A").Select
    Selection.ColumnWidth = 36.57
    Columns("B:B").Select
    Selection.ColumnWidth = 22.29
    Columns("C:C").Select
    Selection.ColumnWidth = 28.57
    Columns("E:E").Select
    Selection.ColumnWidth = 45.71
    Selection.ColumnWidth = 43.43
    Columns("G:G").ColumnWidth = 20.43
    Rows("3:3").Select
    Selection.End(xlDown).Select
    Range("A274:A276").Select
    Range("A276").Activate
    Range(Selection, Selection.End(xlUp)).Select
    ActiveWindow.SmallScroll Down:=-312
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A2:G276").Select
    Range("A276").Activate
    Rows("2:2").RowHeight = 33.75
    Rows("12:12").RowHeight = 50.25
    Rows("2:2").Select
    ActiveWindow.SmallScroll Down:=27
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=12
    Rows("2:276").Select
    
    Selection.RowHeight = 29.25
    Selection.RowHeight = 57.75

'Ajeitar Header
    Columns("A:A").Select
    Selection.ColumnWidth = 46.14
    Rows("2:2").Select
    Selection.RowHeight = 33
    Range("A2:G2").Select
    Selection.Font.Size = 12

'Perfumaria

    Columns("A:A").Select
    Selection.Font.Bold = True
    Columns("B:B").Select
    Selection.Font.Bold = False
    Columns("C:C").Select
    Selection.Font.Bold = True
    Columns("D:D").Select
    Selection.Font.Bold = True
    Selection.Font.Size = 12
    Columns("E:E").Select
    Selection.Font.Bold = False
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.InsertIndent 1
    Range("E2").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("A2:G2").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.InsertIndent 1
    
End Sub