Kev blz!
Adaptei aki como dito e não não sei o pq partindo do 11 = K qdo dou Enter planilha trava e fica maior
tempão Calculando Processador...
Pode por favor dar uma olhadinha ae em meus códigos oq pode ser feito pra corrigir isso...
Private Sub CommandButton1_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton2_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton3_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton4_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton5_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton6_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub CommandButton7_Click()
cxRelatorio.Show vbModeless
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngAlt As Long
If Target.Row < 5 Or Target.Column <> 11 Or Range("AP" & Target.Row).Value = "" Then Exit Sub
Cancel = True: Columns(11).ClearComments: lngAlt = 1.5
If Len(Range("AP" & Target.Row).Value) > 150 Then lngAlt = lngAlt + 1.1
If Len(Range("AQ" & Target.Row).Value) > 150 Then lngAlt = lngAlt + 1.1
If Len(Range("BL" & Target.Row).Value) > 150 Then lngAlt = lngAlt + 1.1
Target.AddComment.Text Text:=Left(Range("AP" & Target.Row).Value, 253) & vbLf & _
Left(Range("AQ" & Target.Row).Value, 253) & vbLf & Left(Range("BL" & Target.Row).Value, 253)
With Target.Comment
With .Shape.TextFrame.Characters.Font
.ColorIndex = 1 'cor da fonte
.Size = 10 'tamanho da fonte
.Name = "Arial" 'tipo da fonte
End With
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 930 Then
.Shape.Width = 930
.Shape.Height = lngAlt * 20
End If
.Visible = True
.Shape.Top = Target.Comment.Parent.Top - 60
.Shape.Left = Target.Comment.Parent.Left - 630
.Shape.Fill.ForeColor.SchemeColor = 41 'cor de preenchimento
End With
End Sub
Option Explicit 'Por kev027
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Colunas As Range
Set Colunas = Range("B5:GY5000")
[A5:A5000] = Clear
If Not Application.Intersect(Colunas, Range(Target.Address)) Is Nothing Then
Linha = Target.Row
Range("A" & Linha).Value = "X"
End If
[B1] = "PG. " & Application.RoundDown(ActiveCell.Row / 47, 0) + 1 'Conta Página
Columns(11).ClearComments
'------------------------------------------------------
'Cor SIM Cor NÃO - Zebrado
'=MOD(LIN();2)=1 Amarelo
'=$A5="X" Laranja
'--------------------------------------------------------
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PosiçãoBarra As Long
Dim Texto As String
Dim Ano As String
Dim AnoCheio As String
Dim TemSinal As String
Application.EnableEvents = False
If Target.Count > 1 Then
Application.EnableEvents = True
Exit Sub
End If
If Target.Row > 1 And Target.Column = 18 Then
If Target.Value <> "" Then
TemSinal = Right(Target.Value, 1)
PosiçãoBarra = InStr(1, Target.Value, "/", vbTextCompare)
Texto = Mid(Target.Value, 1, PosiçãoBarra - 5)
Ano = Mid(Target.Value, PosiçãoBarra + 1, 2)
AnoCheio = Left(Year(Date), 2) & Ano
If TemSinal = "+" Then
Range("BB" & Target.Row).Value = Texto & "/" & AnoCheio & "+"
Range("BB" & Target.Row).Value = UCase(Range("BB" & Target.Row).Value)
Else
Range("BB" & Target.Row).Value = Texto & "/" & AnoCheio
Range("BB" & Target.Row).Value = UCase(Range("BB" & Target.Row).Value)
End If
Else
Range("BB" & Target.Row).Value = " "
End If
End If
Application.EnableEvents = True
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna VndConcl. "BN"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
'If .Column >= 66 And .Column <= 66 Then 'AO ao AO - Coluna VndConcl. (Em baixo)
If .Column >= 13 And .Column <= 13 Then 'M ao M - Coluna VndConcl. (Em baixo)
Range("BO" & .Row).NumberFormat = "@" 'BO - Código tira Fórmulas
Range("BO" & .Row) = Range("BN" & .Row) 'BN - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas Ano "BP"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 13 And .Column <= 13 Then 'M ao M - Coluna Vendas Ano (Em baixo)
Range("BQ" & .Row).NumberFormat = "@" 'BQ - Código tira Fórmulas
Range("BQ" & .Row) = Range("BP" & .Row) 'BP - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Contato Mês/Ano "AS"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 10 And .Column <= 10 Then 'J 10 - Coluna Data dd/mm/aa (Em baixo)
Range("AS" & .Row).NumberFormat = "@" 'AS 45 - Código tira Fórmulas
Range("AS" & .Row) = Range("AR" & .Row) 'AR 44 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Status Online Mês/Ano "AO"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 12 And .Column <= 14 Then 'L 12 - Em baixo
Range("AO" & .Row).NumberFormat = "@" 'AO 41 - Código tira Fórmulas
Range("AO" & .Row) = Range("AN" & .Row) 'AN 40 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Status Online Ano "AM"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 12 And .Column <= 14 Then 'L 12 - Em baixo
Range("AM" & .Row).NumberFormat = "@" 'AM 39 - Código tira Fórmulas
Range("AM" & .Row) = Range("AL" & .Row) 'AL 38 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Pret.Compr.TODOS "BI" 1
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 18 And .Column <= 18 Then 'R ao R - Coluna Pret.Compr.TODOS (Em baixo)
Range("BJ" & .Row).NumberFormat = "@" 'BJ - Código tira Fórmulas
Range("BJ" & .Row) = Range("BI" & .Row) 'BI - Coluna com Fórmulas
'---------------------------------------------------------------------
Range("BH" & .Row) = WorksheetFunction.Trim(Range("BH" & .Row)) 'Remove Espaço à Direita Automático
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Pret. Compra Mês/Ano Ativ/Inat "BD"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 18 And .Column <= 18 Then 'R 18 - Em baixo
Range("BD" & .Row).NumberFormat = "@" 'BD 56 - Código tira Fórmulas
Range("BD" & .Row) = Range("BC" & .Row) 'BC 55 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna StatusDEF ON/OFF "BE"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 14 And .Column <= 14 Then 'N ao N - Coluna StatusDEF (Em baixo)
Range("BF" & .Row).NumberFormat = "@" 'BF - Código tira Fórmulas
Range("BF" & .Row) = Range("BE" & .Row) 'BE - Coluna com Fórmulas
'----------------------------------------------------------------------
Range("BF" & .Row) = WorksheetFunction.Trim(Range("BF" & .Row)) 'Remove Espaço à Direita Automático
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Pret. Compra Mês/Ano "BA"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 18 And .Column <= 18 Then 'R 18 - Em baixo
Range("BA" & .Row).NumberFormat = "@" 'BA 53 - Código tira Fórmulas
Range("BA" & .Row) = Range("AZ" & .Row) 'AZ 52 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Online dd/mm/aa "BR"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 12 And .Column <= 12 Then 'L ao L - Coluna Online dd/mm/aa (Em baixo)
Range("BS" & .Row).NumberFormat = "@" 'BS - Código tira Fórmulas
Range("BS" & .Row) = Range("BR" & .Row) 'BR - Coluna com Fórmulas
'----------------------------------------------------------------------
Range("BS" & .Row) = WorksheetFunction.Trim(Range("BS" & .Row)) 'Remove Espaço à Direita Automático
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2020 "EP"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 134 And .Column <= 145 Then 'ED ao EO - Coluna Anos aaaa (Em baixo)
Range("EQ" & .Row).NumberFormat = "@" 'EQ - Código tira Fórmulas
Range("EQ" & .Row) = Range("EP" & .Row) 'EP - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Vendas Mês/Ano "AY"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 13 And .Column <= 13 Then 'M 13 - Coluna Data dd/mm/aa (Em baixo)
Range("AY" & .Row).NumberFormat = "@" 'AY 47 - Código tira Fórmulas
Range("AY" & .Row) = Range("AX" & .Row) 'AX 46 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2021 "FE"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 149 And .Column <= 160 Then 'ES ao FD - Coluna Anos aaaa (Em baixo)
Range("FF" & .Row).NumberFormat = "@" 'FF - Código tira Fórmulas
Range("FF" & .Row) = Range("FE" & .Row) 'FE - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2024 "GX"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 194 And .Column <= 205 Then 'GL ao GW - Coluna Anos aaaa (Em baixo)
Range("GY" & .Row).NumberFormat = "@" 'GY - Código tira Fórmulas
Range("GY" & .Row) = Range("GX" & .Row) 'GX - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2022 "FT"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 164 And .Column <= 175 Then 'FH ao FS - Coluna Anos aaaa (Em baixo)
Range("FU" & .Row).NumberFormat = "@" 'FU - Código tira Fórmulas
Range("FU" & .Row) = Range("FT" & .Row) 'FT - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2023 "GI"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 179 And .Column <= 190 Then 'FW ao GH - Coluna Anos aaaa (Em baixo)
Range("GJ" & .Row).NumberFormat = "@" 'GJ - Código tira Fórmulas
Range("GJ" & .Row) = Range("GI" & .Row) 'GI - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2016 "CH"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 74 And .Column <= 85 Then 'BV ao CG - Coluna Anos aaaa (Em baixo)
Range("CI" & .Row).NumberFormat = "@" 'CI - Código tira Fórmulas
Range("CI" & .Row) = Range("CH" & .Row) 'CH - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2017 "CW"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 89 And .Column <= 100 Then 'CK ao CV - Coluna Anos aaaa (Em baixo)
Range("CX" & .Row).NumberFormat = "@" 'CX - Código tira Fórmulas
Range("CX" & .Row) = Range("CW" & .Row) 'CW - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2018 "DL"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 104 And .Column <= 115 Then 'CZ ao DK - Coluna Anos aaaa (Em baixo)
Range("DM" & .Row).NumberFormat = "@" 'DM - Código tira Fórmulas
Range("DM" & .Row) = Range("DL" & .Row) 'DL - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Vendas 2019 "EA"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 119 And .Column <= 130 Then 'DO ao DZ - Coluna Anos aaaa (Em baixo)
Range("EB" & .Row).NumberFormat = "@" 'EB - Código tira Fórmulas
Range("EB" & .Row) = Range("EA" & .Row) 'EA - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Contato Ano "AQ"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 10 And .Column <= 10 Then 'J 10 - Coluna Data dd/mm/aa (Em baixo)
Range("AQ" & .Row).NumberFormat = "@" 'AQ 43 - Código tira Fórmulas
Range("AQ" & .Row) = Range("AP" & .Row) 'AP 42 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retornou Mês/Ano "AW"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 17 And .Column <= 17 Then 'Q 17 - Coluna Data dd/mm/aa (Em baixo)
Range("AW" & .Row).NumberFormat = "@" 'AW 47 - Código tira Fórmulas
Range("AW" & .Row) = Range("AV" & .Row) 'AV 46 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retornou Ano "AU"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 17 And .Column <= 17 Then 'Q 17 - Coluna Data dd/mm/aa (Em baixo)
Range("AU" & .Row).NumberFormat = "@" 'AU 47 - Código tira Fórmulas
Range("AU" & .Row) = Range("AT" & .Row) 'AT 46 - Coluna com Fórmulas
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'De Formula para Texto - Retorna Status On Mês/Ano "BG"
'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Cell As Range
For Each Cell In Target
With Cell
If .Column >= 41 And .Column <= 41 Then 'AO ao AO - Coluna Status On Mês/Ano (Em baixo)
Range("BH" & .Row).NumberFormat = "@" 'BH - Código tira Fórmulas
Range("BH" & .Row) = Range("BG" & .Row) 'BG - Coluna com Fórmulas
'---------------------------------------------------------------------
Range("BH" & .Row) = WorksheetFunction.Trim(Range("BH" & .Row)) 'Remove Espaço à Direita Automático
End If
End With
Next
'End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Por Kev027
' Trata possíveis erros
On Error Resume Next
If Target.Value = Empty Then
End
End If
'Sendo 2 = B; 3 = C; 7 = G; 8 = H; 11 = K; 14 = N; 15 = O; 18 = R; 20 = T; 21 = U; 23 = W; 24 = X; 56 = BD; 60 = BH; 62 = BJ; 64 = BL; 71 = BS
Select Case Target.Column
Case 2, 3, 7, 8, 11, 14, 15, 18, 20, 21, 23, 24, 56, 60, 62, 64, 71
If Target.Row >= 5 Then
Target.Value = UCase(Target.Value)
End If
End Select
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
End Sub