Excel Checkbox excel, copiar tabela

[FlaviaTaynara]

Ola pessoal.

 

Desculpe usar esse mesmo post, mas minha duvida esta relacionada.
Sou nova no VBA e não sei nada sobre checkbox, pesquisei em varios sites e tentei varios codigos, porém nenhum funciona como preciso.
Eu tenho um workbook com varias tabs, porém necessiro copiar informações de uma tabela na tab Alert para a mesma tabela na Tab Alert1 somente se a checkbox na coluna L2 estiver selecionada. (posso usar um botao na tab Alert1 para copiar as linhas da tabela que tiver o checkbox selecionado na colina L2).

obrigada
 

 

 

 

[mick 07]

@FlaviaTaynara dúvida movida para tópico próprio, abraços.

[Visitante]

2 horas atrás, FlaviaTaynara disse:

 ... copiar informações de uma tabela na tab Alert para a mesma tabela na Tab Alert1...

 

 

Se entendi corretamente Alert e Alert1 são nomes de duas planilhas, é isso?

Aí você diz que quer copiar de uma tabela e colar na mesma tabela que estaria em outra planilha. 

Não entendi.

 

Sugestão: disponibilize diretamente aqui no fórum uma amostra do seu arquivo Excel, coloque um exemplo na planilha e coloque também o resultado desejado.

 

[FlaviaTaynara]

 

@osvaldomp Infelizmente o meu excel esta restrito e mesmo que coleque o arquivo aqui não conseguira abrir em outro computador.
sim voce esta correto, Alert  e Alert1 sao os nomes da tab (irei colocar um print melhor). O que quero é copiar as informações que esteja disponivel na tabela da tab Alert (porém apenas se o checkbox estiver selecionado na coluna M (L2)). 
Sinceramente não sei usar checkbox, não sei se para isso necessito o form controls ou activeXcontrol. 

 

muito Obrigada.

 

 

 

[Patropi]

Boa noite @FlaviaTaynara

 

Fiz o que entendi que você deseja, mas sem VBA, utilizando apenas fórmulas.

 

Confira na planilha e dê retorno.

 

Não se esqueça de clicar em Curtir.

 

[]s

 

[FlaviaTaynara]

@osvaldomp consegui anexar o arquivo (mas o macro não aparece, porém ja da para ter uma ideia)

 

 

 

 

@Patropi Bom dia,

 

Muito obrigada pela ajuda.

 

A primeira parte esta funcionando perfeitamente, porém não consigo corrigir a formula para as informações aparecerem na tabela da aba Alert XX.XX.XXXX (Level 2).

 

eu tentei esta formula.

 

=IFERROR(INDEX(ALERT XX.XX.XXXX!$H$2:$H$7,MATCH(ROW(A1),Clc!$AT$2:$AT$7,0))),'')&''

ROW(A1) não entendi esta parte da formula.

 

(meu excel esta em inglês normalmente quando tenho " no meu seria ')

 

consegui anexar o excel file (porém o macro não aparece nenhum...) eu creio que se fosse VBA não teria problema quando o nome da aba muda. 

 

A aba sempre que clica no botao salvar ira mudar o nome dapara a cada do dia (entao não sei se isso aferatia as checkbox). 

 

 

muito obrigada pela ajuda

 

[Visitante]

 

Experimente:
 

Sub ReplicaDados()
 Dim ws As Worksheet, wsD As Worksheet, chb As CheckBox
  Application.ScreenUpdating = False
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name Like "Alert * (Level 2)" Then
    Set wsD = ws: Exit For
   End If
  Next ws
  wsD.[H2:L6] = ""
 For Each chb In ActiveSheet.CheckBoxes
  If chb.TopLeftCell.Column = 13 And chb = xlOn Then
   Cells(chb.TopLeftCell.Row, 8).Resize(, 5).Copy
   wsD.Cells(Rows.Count, 8).End(3)(2).PasteSpecial xlValues
   'Cells(chb.TopLeftCell.Row, 8).Resize(, 5) = "": chb = xlOff
  End If
 Next chb
 Application.ScreenUpdating = True
End Sub

obs.

1. considerei que ao rodar o código a planilha ativa será a planilha que contém os dados, no seu exemplo a planilha Alert XX.XX.XXXX

2. antes de replicar os dados o código irá limpar o intervalo H2:L6 da planilha destino (Alert XX.XX.XXXX (Level 2)); se você não quiser limpar, então comente ou exclua esta linha do código ~~~> wsD.[H2:L6] = ""

3. se após replicar os dados você quiser limpar as linhas de origem e desmarcar as Caixas de Seleção então (descomente) remova o apóstrofo ínicial desta linha do código ~~~>  'Cells(...

[FlaviaTaynara]

@osvaldomp  Muito Obrigada,
 

 

Muito Obrigada, esta funcionando perfeitamente.

 

Eu criei um Botao para iniciar o macro e assign o Macro a ele e esta funcionando perfeitamente. 

 

porém, eu notei que se alguma Checkbox da coluna M (L2) estiver selecionanda quando clico no botao Save File (no alert XX.XX.XXXX (Level 2) ) o mesmo nao funciona (ele salva o arquivo como se fosse a aba Alert XX.XX.XXXX, ou seja ele salva sobre o arquivo que ja estava salvo como o nome (do alerta Data ) sem o (Level 2) no final. 

teria algum motivo para isso? 

 

Ja se nenhuma checkbox estiver selecionada o botao Salve File da aba Alert XX.XX.XXXX (Level 2) funcionando perfeitamente como se deve. 

 

A maneira que os arvivos devem salvar o arquivo quando for clicado:

 

No me do alerta + data (por exemplo o nome do alerta é "Cien")

Se  o botao Save File na aba Alert XX.XX.XXXX for selecionado o arquivo sera automaticamente salvo como:  Cien 03.26.2020 

Se  o botao Save File na aba Alert XX.XX.XXXX (Level 2) for selecionado o arquivo sera automaticamente salvo como: Cien 03.26.2020  (Level 2)

 

Seria possivel por uma linha no codigo para que se a checkbox esteja ou nao selecionada  nao afete na hora que o save file botao do Alert XX.XX.XXXX (Level 2) seja selecionado?

 

 

Obrigada pelo seu tempo. 

 

 

 

[Visitante]

1 hora atrás, FlaviaTaynara disse:

porém, eu notei que se alguma Checkbox da coluna M (L2) estiver selecionanda ... sem o (Level 2) no final. 

teria algum motivo para isso? 

Ja se nenhuma checkbox estiver selecionada o botao Salve File da aba Alert XX.XX.XXXX (Level 2) funcionando perfeitamente como se deve. 

Não vejo qualquer interferência ou relação entre o código que passei e o salvamento do arquivo.

 

Seria possivel por uma linha no codigo para que se a checkbox esteja ou nao selecionada  nao afete na hora que o save file botao do Alert XX.XX.XXXX (Level 2) seja selecionado?

A sua ideia é acrescentar uma linha a qual código? Se for ao código que passei, não faz sentido. Se for aos seus códigos que fazem o salvamento então precisamos ver os códigos.

 

 

[FlaviaTaynara]

@osvaldomp Bom dia,

 

Tens razao, teu codigo esta funcionando perfeitamente.

Notei que nao tem relação se a checkbox estiver selecionado ou nao, o Botao de Save File da aba Alert XX.XX.XXXX (Level 2) nao funciona quando o file ja salvo no Alert XX.XX.XXXX e é aberto novamente pelo time do Level 2 e ao tentar salvar o mesmo usando o Save File no Alert XX.XX.XXXX (Level 2).  (porém isso é exatamente o que preciso corrigir, pois o time do Level 2 usa o arquivo salvo pelo Alert XX.XX.XXXX para fazer as mudancas necessarias e salva como um novo aquivo).

 

Este codigo é o praticamente o mesmo para o botao Salve File no Alert XX.XX.XXXX

preciso modificar umas coisas (como informações que se deve aparecer no closing note), porém essas mudancas nao irao interferir com o Botao salvar.  

 

Talvez tu consegue ver onde esta meu erro e o por que se uso o arquivo do excel ja salvo (ja com o nome alterado ex: Cien 03.26.2020  o mesmo noa pode ser salvo como um novo arquivo alterando o nome como se é esperado ex: Cien 03.26.2020  (Level 2) ??

 

mais uma vez muito obrigada.

'Salve Fale na Aba Alert XX.XX.XXXX 

Sub SaveFile()
Dim ws As Worksheet
Call RemLink
If ClientReview.Visible = True Then
Set Client = ClientReview
Else

 For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Client Review*" Then
     Set Client = ws
     
     End If
 Next ws
End If

If CheckForPics = False Then Exit Sub

If CalculationSheet.Range("AP1").Value = True Or CalculationSheet.Range("AP2").Value = True Or CalculationSheet.Range("AP3").Value = True Or CalculationSheet.Range("AP4").Value = True Or CalculationSheet.Range("AP5").Value = True Then
    If CheckforWC = False Then Exit Sub
End If

If NotFilled = False Then Exit Sub
If NotFilledRules = False Then Exit Sub
If NotFilledClient = False Then Exit Sub

If Client.Range("H1").Value <> "" Then
        If CalculationSheet.Range("AP6").Value = True Then
        Debug.Print "Works"
      If CheckForClientWC = False Then Exit Sub
    End If
    If CheckForClientNegative = False Then Exit Sub
    
    
  End If
Alert.Cells.CheckSpelling
ClientReview.Cells.CheckSpelling

If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then
 ActiveWorkbook.Save
 MsgBox " File has been saved successfully."
 Exit Sub
End If

ClientReview.Activate
today = Format(Date, "MM.DD.YYYY")
Range("C6").Value = today

savePath = Environ("userprofile") 'get unique path for every user
CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value
CompanyName = Replace(CompanyName, "&", "")
CompanyName = Replace(CompanyName, "/", "")
CompanyName = Replace(CompanyName, "\", "")
CompanyName = Replace(CompanyName, ":", "")
CompanyName = Replace(CompanyName, "*", "")
CompanyName = Replace(CompanyName, "?", "")
CompanyName = Replace(CompanyName, Chr(34), "")
CompanyName = Replace(CompanyName, "<", "")
CompanyName = Replace(CompanyName, ">", "")
CompanyName = Replace(CompanyName, "|", "")

UserName = Application.UserName
Alert.Visible = xlSheetVisible
Alert.Activate
Range("C1").Value = UserName
Alert.Name = "Alert " & today

If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then
   MkDir (savePath & "\Desktop\Investigations")
End If

On Error GoTo ErrorMessage
    ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls"

    MsgBox "File has been successfully saved to investigations folder in user's desktop."
Exit Sub



ErrorMessage:
MsgBox "Something went wrong, file not saved!"
End Sub

Sub SaveFileWithoutAlertTab()
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag
Call RemLink
        If CalculationSheet.Range("AP6").Value = True Then
      If CheckForClientWC = False Then Exit Sub
    End If
    If CheckForClientNegative = False Then Exit Sub
    If NotFilledClient = False Then Exit Sub
    ClientReview.Cells.CheckSpelling



ClientReview.Activate
today = Format(Date, "MM.DD.YYYY")
Range("C6").Value = today

savePath = Environ("userprofile") 'get unique path for every user
CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value
CompanyName = Replace(CompanyName, "&", "")
CompanyName = Replace(CompanyName, "/", "")
CompanyName = Replace(CompanyName, "\", "")
CompanyName = Replace(CompanyName, ":", "")
CompanyName = Replace(CompanyName, "*", "")
CompanyName = Replace(CompanyName, "?", "")
CompanyName = Replace(CompanyName, Chr(34), "")
CompanyName = Replace(CompanyName, "<", "")
CompanyName = Replace(CompanyName, ">", "")
CompanyName = Replace(CompanyName, "|", "")
UserName = Application.UserName

If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then
   MkDir (savePath & "\Desktop\Investigations")
End If

Alert.Visible = xlSheetVeryHidden

On Error GoTo ErrorMessage
    ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & ".xls"

Alert.Visible = xlSheetVisible
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
MsgBox "File has been successfully saved to investigations folder in user's desktop."
Exit Sub

ErrorMessage:
MsgBox "Something went wrong, file not saved!"


End Sub


Sub CopyPasteFromDownloadedClientReviewSheet()

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag

ClientReviewTabIsHided = False
ClientReview.Visible = xlSheetVeryHidden
ClientReview.Name = "Original Client Review"

On Error GoTo ErrorTrue
Worksheets(1).Activate
Dim ws As Worksheet
Dim DownloadedClientReviewSheet As Worksheet
today = Format(Date, "MM.DD.YYYY")
For Each ws In ThisWorkbook.Worksheets
    
    ws.Activate
    If ws.Name Like "Client Review*" Then
        Set DownloadedClientReviewSheet = ActiveSheet
        DownloadedClientReviewSheet.Name = "Client Review" & " " & today
        GoSub CopyPasteFromDownloadedClientReview
        Exit For
    End If
    
Next ws

CopyPasteFromDownloadedClientReview:

Range("C1:C2").Select
Selection.Copy
Alert.Activate
Range("C2").PasteSpecial xlPasteValues
'Unmerge client summary in Alert sheet to make it available for pasting
'Range("K16").UnMerge

'DownloadedClientReviewSheet.Activate
'DownloadedClientReviewSheet.Range("H1:H2").Value = ""
'Range("J3:L8").UnMerge
'Range("J3").Copy
'Alert.Activate
'Range("K16").PasteSpecial xlPasteValues
'Range("K16:Q22").Merge
'DownloadedClientReviewSheet.Activate
Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3"
'Range("J3:L8").Merge
'Alert.Activate

ClientReviewTabIsHided = True

Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True

Exit Sub
ErrorTrue:
ClientReview.Visible = xlSheetVisible
ClientReview.Name = "Client Review"
Alert.Activate
Range("K16:Q22").Merge
MsgBox "No manually added sheets identified."
End Sub

Sub ClearAll()

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag

'Delete all pictures
Dim Sh As Shape
Dim sheetnumber As Integer
Dim ws As Worksheet
Dim starting_ws As Worksheet

VBanswer = MsgBox("Do you want to refresh the template?", vbYesNo, "Refresh Template")

If VBanswer = vbYes Then
    GoSub ClearOut
Else
    Exit Sub
End If

ClearOut:

Alert.Visible = xlSheetVisible
Alert.Name = "Alert XX.XX.XXXX"

ClientReview.Visible = xlSheetVisible
ClientReview.Name = "Client Review"

Worksheets(1).Select
Set starting_ws = ActiveSheet

For Each ws In ThisWorkbook.Worksheets

    ws.Activate
    If ws.Name <> "Client Review" And ws.Name <> "Alert XX.XX.XXXX" And ws.Name <> "Closing Notes" And ws.Name <> "EmailData" And ws.Name <> "Red Flags" And ws.Name <> "AutoRules" And ws.Name <> "PivotBene" And ws.Name <> "Version Control" And ws.Name <> "Clc" And ws.Name <> "Countries" And ws.Name <> "Transaction Details" And ws.Name <> "Pivot" And ws.Name <> "Business Rule Justifications" And ws.Name <> "12 Months" And ws.Name <> "RFI Submition Contacts" And ws.Name <> "RFI Questions" And ws.Name <> "Exceptions" And ws.Name <> "12_Months_Pivot" Then
        ActiveSheet.Delete
    End If

Next

'Dim wbBook As Workbook
'Dim nName As Name

'Set wbBook = ActiveWorkbook

'For Each nName In wbBook.Names
'nName.Delete
'Next nName


For sheetnumber = 1 To Sheets.count
    For Each Sh In Sheets(sheetnumber).Shapes
        If Sh.Type = msoPicture Then Sh.Delete
    Next
Next sheetnumber

'clear named ranges



'CLIENT REVIEW TAB
Sheets("Client Review").Activate
Range("C1:C3").Value = ""
Range("C6").Value = ""
Range("H1:H2").Value = ""
Range("G8:H12").Value = ""
Range("J3").Value = "The client has been with WUBS since XXX and has been incorporated since MMDDYY. The expected average transaction volume in currency is YYY and the expected average frequency is ZZZ payments YXX. The client transacts with the following location(s) XXX. The client [ClientDescription] and intends to use WUBS for [PayPurpose]. Further information is located in client's Sales Force profile."

'comments
Sheets("Client Review").Range("C214:G217").Value = ""
Sheets("Client Review").Range("C150:G153").Value = ""
Sheets("Client Review").Range("C108:G111").Value = ""
Sheets("Client Review").Range("g59:G65").Value = ""

Range("C59:F59").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 1"")"
Range("C60:F60").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 2"")"
Range("C61:F61").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 3"")"
Range("C62:F62").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 4"")"
Range("C63:F63").FormulaR1C1 = "=IF(R[-51]C[4]<>"""",R[-51]C[4],""UBO 5"")"
Range("C64:F64").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Client name for search"")"
Range("C65:F65").FormulaR1C1 = "=IF(R[-63]C[5]<>"""",R[-63]C[5],""Trading name for search"")"


'ALERT TAB
Alert.Activate
Range("C1").Value = ""
Range("H2:L6").Value = ""
Range("O2").Value = ""
Range("B16").Value = CalculationSheet.Range("Default_Closing_Notes").Value

Range("K16:Q22").Merge

Range("C2").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")"
Range("C3").FormulaR1C1 = "=IF('Client Review'!R[-1]C<>"""",'Client Review'!R[-1]C,"""")"
Range("K16").FormulaR1C1 = "='Client Review'!R[-13]C[-1]"


Range("C66").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 1"")"
Range("C67").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 2"")"
Range("C68").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 3"")"
Range("C69").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 4"")"
Range("C70").FormulaR1C1 = "=IF(R[-64]C[5]<>"""",R[-64]C[5],""Bene 5"")"


'Delete all comments
Alert.Range("C318:G321").Value = ""
Alert.Range("C270:G273").Value = ""
Alert.Range("C230:G233").Value = ""
Alert.Range("C189:G192").Value = ""
Alert.Range("C148:G151").Value = ""
Alert.Range("C107:G110").Value = ""
Alert.Range("G66:G70").Value = ""
Countries.Visible = False
Grid.Visible = False
Pivot.Visible = False
CalculationSheet.Visible = False
Avarage.Visible = False
PivotBene.Visible = False
AutoRules.Visible = False
RedFlagss.Visible = False


ClientReview.Range("C23").Value = ""

CalculationSheet.Range("B100:B121").Value = "FALSE"
CalculationSheet.Range("OutTransactionsStartDate").Value = "XXZ"
CalculationSheet.Range("OutTransactionsEndDate").Value = "YYX"
CalculationSheet.Range("broken_rules").Value = "ZZX"
CalculationSheet.Range("rules_count").Value = ""


CalculationSheet.Range("BeneficiaryInfoFromTable").Value = CalculationSheet.Range("K7").Value
CalculationSheet.Rows("150:" & Rows.count).ClearContents
CalculationSheet.Range("RulesForWhiteListing").Value = ""
CalculationSheet.Range("RuleCountToWhiteList").Value = ""
CalculationSheet.Range("RulesJustification").Value = CalculationSheet.Range("K9").Value
CalculationSheet.Range("Ending").Value = CalculationSheet.Range("K3").Value
CalculationSheet.Range("redflags").Value = CalculationSheet.Range("K5").Value
CalculationSheet.Range("Benecc").Value = "XXX"
CalculationSheet.Range("C6").Value = ""
CalculationSheet.Range("AP1:AP6").Value = "False"
ClientReview.Range("D67").Value = ""

EmailData.Cells.Clear
Pivot.Cells.Clear
Grid.Cells.Clear
Avarage.Cells.Clear
Alert.Range("P2").Value = ""

Alert.Range("D32").Value = ""
CalculationSheet.Range("I2:I" & CalculationSheet.Cells(Rows.count, 9).End(xlUp).Row).Value = ""


ClientReview.Range("C67").Value = ""
ClientReview.Range("D67").Value = ""
ClientReview.Range("C114").Value = ""
CalculationSheet.Range("C3:H30").Value = ""
avarage_pivot.Visible = False

On Error Resume Next
PivotBene.PivotTables("BeneNames").TableRange2.Clear
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SlicerCaches("Slicer_Bene_Names").Delete
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SlicerCaches("Slicer_Dates").Delete
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SlicerCaches("Slicer_Bene_Name").Delete
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SlicerCaches("Slicer_Bene_Name1").Delete
On Error GoTo 0

AutoRules.Range("E2:Z50").Clear

PivotBene.Rows("2:" & Rows.count).ClearContents
avarage_pivot.Rows.Delete
Application.GoTo Reference:=Range("a1"), Scroll:=True
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True


MsgBox "Template has been refreshed.", vbOKOnly, "Information"

End Sub


Private Sub Workbook_Open()

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False

Dim openPath, FilePath As String
Dim data_file As Workbook

    Set WBMain = ThisWorkbook
    
    openPath = Environ("userprofile")
    FilePath = (openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx")
    
    If CalculationSheet.Range("A25").Value <> FileDateTime(FilePath) Then
        exceptions.Rows.Clear
        rfi_contacts.Rows.Clear
        rfi_questions.Rows.Clear
        Set data_file = Workbooks.Open(openPath & "\Box\WUBS GAI & SAR REPORTING\Distribution lists (IRIS TMS case, World-Check, Fintrac)\Distribution WU WAY\Data for Templates.xlsx")
        data_file.Sheets("RFI Submition Contacts").Range("A:M").Copy rfi_contacts.Range("A1")
        data_file.Sheets("RFI Questions").Range("A:C").Copy rfi_questions.Range("A1")
        data_file.Sheets("Rule Exceptions").Range("A:C").Copy exceptions.Range("A1")
        data_file.Close
        CalculationSheet.Range("A25").Value = FileDateTime(FilePath)
    End If
    
    


Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True


End Sub

--
-----------
--

'Salve File na Aba Alert XX.XX.XXXX (Level 2)


Option Explicit

Sub Save_Level_2_File()
Dim ws As Worksheet
Dim Client As ClientReview

Call RemLink2
If ClientReview.Visible = True Then
Set Client = ClientReview
Else

 For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Client Review*" Then
     Set Client = ws
     
     End If
 Next ws
End If

If CheckForPics2 = False Then Exit Sub

If CalculationSheet.Range("AR1").Value = True Or CalculationSheet.Range("AR2").Value = True Or CalculationSheet.Range("AR3").Value = True Or CalculationSheet.Range("AR4").Value = True Or CalculationSheet.Range("AR5").Value = True Then
    If CheckforWC = False Then Exit Sub
End If

If NotFilled = False Then Exit Sub
If NotFilledRules = False Then Exit Sub
If NotFilledClient = False Then Exit Sub

If Client.Range("H1").Value <> "" Then
        If CalculationSheet.Range("AR6").Value = True Then
        Debug.Print "Works"
      If CheckForClientWC = False Then Exit Sub
    End If
    If CheckForClientNegative = False Then Exit Sub
    
    
  End If
Alert1.Cells.CheckSpelling
ClientReview.Cells.CheckSpelling

If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then
 ActiveWorkbook.Save
 MsgBox " File has been saved successfully."
 Exit Sub
End If

Dim today As String
Dim savePath As String
Dim CompanyName As String
Dim UserName As String

ClientReview.Activate
today = Format(Date, "MM.DD.YYYY")
Range("C6").Value = today

savePath = Environ("userprofile") 'get unique path for every user
CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value
CompanyName = Replace(CompanyName, "&", "")
CompanyName = Replace(CompanyName, "/", "")
CompanyName = Replace(CompanyName, "\", "")
CompanyName = Replace(CompanyName, ":", "")
CompanyName = Replace(CompanyName, "*", "")
CompanyName = Replace(CompanyName, "?", "")
CompanyName = Replace(CompanyName, Chr(34), "")
CompanyName = Replace(CompanyName, "<", "")
CompanyName = Replace(CompanyName, ">", "")
CompanyName = Replace(CompanyName, "|", "")

UserName = Application.UserName
Alert1.Visible = xlSheetVisible
Alert1.Activate
Range("C1").Value = UserName
Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2

If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then
   MkDir (savePath & "\Desktop\Investigations")
End If

On Error GoTo ErrorMessage
    ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls"

    MsgBox "File has been successfully saved to investigations folder in user's desktop."
Exit Sub



ErrorMessage:
MsgBox "Something went wrong, file not saved!"
End Sub

Sub CopyPasteFromDownloadedClientReviewSheet()

Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag

ClientReviewTabIsHided = False
ClientReview.Visible = xlSheetVeryHidden
ClientReview.Name = "Original Client Review"

On Error GoTo ErrorTrue
Worksheets(1).Activate
Dim ws As Worksheet
Dim DownloadedClientReviewSheet As Worksheet
today = Format(Date, "MM.DD.YYYY")
For Each ws In ThisWorkbook.Worksheets
    
    ws.Activate
    If ws.Name Like "Client Review*" Then
        Set DownloadedClientReviewSheet = ActiveSheet
        DownloadedClientReviewSheet.Name = "Client Review" & " " & today & "" & "(Level 2)"
        GoSub CopyPasteFromDownloadedClientReview
        Exit For
    End If
    
Next ws

CopyPasteFromDownloadedClientReview:

Range("C1:C2").Select
Selection.Copy
Alert1.Activate
Range("C2").PasteSpecial xlPasteValues
'Unmerge client summary in Alert sheet to make it available for pasting
'Range("K16").UnMerge

'DownloadedClientReviewSheet.Activate
'DownloadedClientReviewSheet.Range("H1:H2").Value = ""
'Range("J3:L8").UnMerge
'Range("J3").Copy
'Alert.Activate
'Range("K16").PasteSpecial xlPasteValues
'Range("K16:Q22").Merge
'DownloadedClientReviewSheet.Activate
Alert.Range("K16").Value = "='" & DownloadedClientReviewSheet.Name & "'!J3"
'Range("J3:L8").Merge
'Alert.Activate

ClientReviewTabIsHided = True

Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True

Exit Sub
ErrorTrue:
ClientReview.Visible = xlSheetVisible
ClientReview.Name = "Client Review"
Alert.Activate
Range("K16:Q22").Merge
MsgBox "No manually added sheets identified."
End Sub

Sub RemLink2() 'Excel VBA remove links from workbook.
Dim ar As Variant
Dim i As Integer

ar = ActiveWorkbook.LinkSources(1)

On Error Resume Next 'Trap error

For i = 1 To UBound(ar) 'Excel VBA loop throuh links
ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks
Next i

On Error GoTo 0

End Sub

Function CheckForPics2() As Boolean

Dim ReturnValue As Boolean
Dim nm As String
Dim picBox As Integer
Dim i As Long
Dim tnm As String
CheckForPics2 = True

For i = 2 To 6
If Range("H" & i).Value <> "" Then
picBox = i
ReturnValue = CheckPic2(picBox)

Dim result As String

  If ReturnValue = False Then
  tnm = CalculationSheet.Range("W" & i).Value
  result = MsgBox("No screenshots for " & tnm & " were found." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2)
     If result = vbNo Then
     CheckForPics2 = False
     Exit For
     Else: CheckForPics2 = True
     End If
     Else: CheckForPics2 = True
     
  End If
Else
Exit For

End If

Next i

End Function

Function CheckPic2(xRg As Integer) As Boolean

Dim Client As Object

Dim xpicRg As Range
Dim nRg As String
Dim nRg1 As Integer
Dim nRg2 As Integer
Dim ws As Worksheet
If ClientReview.Visible = True Then
Set Client = ClientReview
Else

 For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Client Review*" Then
     Set Client = ws
     
     End If
 Next ws
End If


If xRg < 7 Then
Alert1.Activate
Else

Client.Activate


End If
nRg = CalculationSheet.Range("V" & xRg).Value
nRg1 = Split(nRg, ":")(0)
nRg2 = Split(nRg, ":")(1)
Debug.Print "ngr1: " & nRg1
Debug.Print "nrg2: " & nRg2

Dim xPic As Object

For Each xPic In ActiveSheet.Pictures
    Debug.Print "xPic: " & xPic.TopLeftCell.Row
    If xPic.TopLeftCell.Row >= nRg1 And xPic.TopLeftCell.Row <= nRg2 Then
    Debug.Print "Ok"
    CheckPic2 = True
    Exit For

    Else
    CheckPic2 = False
    End If
Next


End Function

Function NotFilled2() As Boolean

Dim vl As String
Dim Mnm As String
Dim spos As Long
Dim i As Integer
Dim lenghts As Integer
Dim result As Integer


For i = 2 To 10
vl = CalculationSheet.Range("Z" & i).Value
Mnm = CalculationSheet.Range("AA" & i).Value

If InStr(Alert1.Range("B16").Value, vl) Then
Alert1.Activate
Alert1.Range("B16").Select
spos = InStr(Alert1.Range("B16").Value, vl)
lenghts = Len(vl)
Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.ColorIndex = 3
Alert1.Range("B16").Characters(Start:=spos, Length:=lenghts).Font.Bold = True
result = MsgBox(Mnm & " was not entered in Closing Notes." & vbNewLine & "Do you still want to save file?", vbYesNo + vbQuestion + vbDefaultButton2)

If result = vbYes Then
NotFilled2 = True
Else
NotFilled2 = False
Exit For


End If

Else: NotFilled2 = True


End If


Next i


End Function



 

 

[Visitante]

Sugestão: esqueça por um momento esses quilômetros de códigos e nos diga exatamente o que você quer fazer ao salvar o arquivo. Assim, poderemos tentar elaborar um código, pois revisar os códigos que você postou aí acima é tarefa insana.

[FlaviaTaynara]

1 hora atrás, osvaldomp disse:

Sugestão: esqueça por um momento esses quilômetros de códigos e nos diga exatamente o que você quer fazer ao salvar o arquivo. Assim, poderemos tentar elaborar um código, pois revisar os códigos que você postou aí acima é tarefa insana.

Desculpa acabei me empolgando. 

 

Neste momento estou revisando o codigo do Salve File da aba Alert XX.XX.XXXX (Level 2) que esta do modulo Level_2 e ja anotei varias partes que pode ser deletada.

O que eu preciso é:

 

Que quando o botao Save File da aba Alert XX.XX.XXXX (Level 2) funcione salvando um novo arquivo com mesmo nome apenas acrescentando (Level 2) na frente ex:

CCISD 03.26.2020 (o botao save file na aba Alert XX.XX.XXXX criou este arquivo quando foi selecionado).

O time do level 2 ira usar este arquivo criado por ele e fazer suas anotacoes na Aba do Level 2 e ira salvar novamente, pore neste momento usando o botao Save File disponivel na Aba Alert XX.XX.XXXX (Level 2) e o novo arquivo tera o nome de ex:

CCISD 03.27.2020 (Level 2).

 

 

preciso fazer como um novo arquivo com o mesmo nome que o anterior so acrescentando (Level 2 a frente) e chegar. 

 

 

Sub Save_Level_2_File()
Dim ws As Worksheet
Dim Client As ClientReview

Alert1.Cells.CheckSpelling
ClientReview.Cells.CheckSpelling

If Application.ActiveWorkbook.Path = Environ("userprofile") & "\Desktop\Investigations" Then
 ActiveWorkbook.Save
 MsgBox " File has been saved successfully."
 Exit Sub
End If

Dim today As String
Dim savePath As String
Dim CompanyName As String
Dim UserName As String

ClientReview.Activate
today = Format(Date, "MM.DD.YYYY")
Range("C6").Value = today

savePath = Environ("userprofile") 'get unique path for every user
CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value
CompanyName = Replace(CompanyName, "&", "")
CompanyName = Replace(CompanyName, "/", "")
CompanyName = Replace(CompanyName, "\", "")
CompanyName = Replace(CompanyName, ":", "")
CompanyName = Replace(CompanyName, "*", "")
CompanyName = Replace(CompanyName, "?", "")
CompanyName = Replace(CompanyName, Chr(34), "")
CompanyName = Replace(CompanyName, "<", "")
CompanyName = Replace(CompanyName, ">", "")
CompanyName = Replace(CompanyName, "|", "")

UserName = Application.UserName
Alert1.Visible = xlSheetVisible
Alert1.Activate
Range("C1").Value = UserName
Alert1.Name = "Alert " & today & " (Level 2)" ' button save file Level 2

If Len(Dir(savePath & "\Desktop\Investigations", vbDirectory)) = 0 Then
   MkDir (savePath & "\Desktop\Investigations")
End If

On Error GoTo ErrorMessage
    ActiveWorkbook.SaveCopyAs Filename:=savePath & "\Desktop\Investigations\" & CompanyName & " " & today & " (Level 2)" & ".xls"

    MsgBox "File has been successfully saved to investigations folder in user's desktop."
Exit Sub



ErrorMessage:
MsgBox "Something went wrong, file not saved!"
End Sub

 

CCISD 03.26.2020.xlsx

adicionado 27 minutos depois

@osvaldomp Ah esqueci de mencionar que o nome do arquivo é baseado no nome do Client name for search (Na coluna C linha 1) que se encontra na aba Client Review.

[Visitante]

Experimente:

Sub SalvaComo()
 Application.DisplayAlerts = False
 If ActiveSheet.Name Like "*(Level 2)" Then
  ThisWorkbook.SaveAs Filename:=Sheets("Client Review").[C1] & " " & Format(Date, "mm.dd.yyyy") & " (Level 2).xlsm"
 Else: ThisWorkbook.SaveAs Filename:=Sheets("Client Review").[C1] & " " & Format(Date, "mm.dd.yyyy") & ".xlsm"
 End If
End Sub

obs.

1. vincule ao código acima os botões Save File tanto da planilha Alert como da planilha Alert (Level 2)

2. antes de rodar o código pela primeira vez o arquivo atual deverá estar salvo (com qualquer nome)

3. o novo arquivo será salvo na mesma pasta do arquivo atual

4. ao clicar no botão da planilha Alert o novo arquivo será salvo como ~~~> Client Review!C1 & data atual mm.dd.aaaa, então se salvar o arquivo hoje (27/mar/20) o nome será CCISD 03.27.2020

5. ao clicar no botão na planilha Alert (Level 2) o arquivo será salvo como ~~~> Client Review!C1 & data atual mm.dd.aaaa & (Level 2), então se salvar o arquivo hoje (27/mar/20) o nome será CCISD 03.27.2020 (Level 2)

[FlaviaTaynara]

 

@osvaldomp  Bom dia,

 

O codigo funcionou, porém o mesmo salvou em cima do arquivo ja salvo pelo Alert (CCISD 03.27.2020).

 

Eu esqueci de mencionar que o nome do cliente é extraido de um outro programa e por isso tem essa parte no codigo para poder arrumar o nome como os times necessitao.  

savePath = Environ("userprofile") 'get unique path for every user
CompanyName = ThisWorkbook.Sheets(1).Range("C1").Value
CompanyName = Replace(CompanyName, "&", "")
CompanyName = Replace(CompanyName, "/", "")
CompanyName = Replace(CompanyName, "\", "")
CompanyName = Replace(CompanyName, ":", "")
CompanyName = Replace(CompanyName, "*", "")
CompanyName = Replace(CompanyName, "?", "")
CompanyName = Replace(CompanyName, Chr(34), "")
CompanyName = Replace(CompanyName, "<", "")
CompanyName = Replace(CompanyName, ">", "")
CompanyName = Replace(CompanyName, "|", "")

Somos 2 times: Level 1 e Level 2.

O level 1 ira usar excel file (que neste momento tem outro nome, um nome generico) para fazer as investigacoes necesarias. 

Os dados como cliente e beneficiarios sao extraidos de um outro programa e transferido para o template do excel. 

Apos o time 1 terminar suas anotacoes o mesmo ira usar usar o botao salve file na aba Alert e automaticamente um novo arquivo sere salvo em uma pasta especifica neste caso e ("\Desktop\ Ingestigations\").

 

O time 2 ira receber o arquivo salvo pelo time 1 e comecara a trabalhar nele e apos terminar tambem ira usar o botao Save File (porém na aba do Level 2) para que o mesmo seja salvo tambem em uma local especificico ("\Desktop\ Ingestigations\").

 

Eu notei que: se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 nao tiver o arquivo do time 1 salvo, ao apertar o botao save file na aba do level 2 o mesmo ira salver corretamente. 

porém se na pasta de destino ("\Desktop\ Ingestigations\") do level 2 ja existir o arquivo salvo pelo time 1 o botao ira apenas apenas salvar uma atualizacao do mesmo, salvando em cima do que arquivo que ja existe. 

 

Uma das opções que acho que poderia funcionar seria fazer outra pasta de destino para o time do level 2 ex: \Desktop\ Ingestigations Level 2\ ou mudar completamente o codigo do level 2. 

 

A unica coisa que o codigo do level 2 precisa fazer antes de salvar como um novo arquivo e novo nome é chegar se o screenshots estão no local correto e corrigir erros de ortografia, enato ira salvar na pasta de destino. ("\Desktop\ Ingestigations\").

 

ob: O time do level 2 normalmente nao faz nenhuma auteracao na aba do cliente e nem insere nenhum dado de outros programas, logo a data que se encontra na aba Cliente Review sera a data em que o time 1 salvou o arquivo (usando o botao da aba Alert).

 

Obrigada pela paciencia comigo e por toda a ajuda.

 

[Visitante]

Eu vou considerar somente dois pontos que estão diretamente ligados ao código que passei, cujo objetivo é salvar o arquivo.

1. "porém o mesmo salvou em cima do arquivo ja salvo" ~~~> sim, se o arquivo já foi salvo e você manda salvar novamente então supõe-se que você fez alterações e quer atualizar o arquivo. Se você não quer atualizar então não salve pela segunda vez. No entanto, se você quer salvar e manter o anterior, então será preciso salvar com outro nome.

 

2. "nome do cliente é extraido de um outro programa e por isso tem essa parte no codigo para poder arrumar o nome" ~~~> sugestão: elabore um novo código que contenha somente as tais instruções que "arrumam" o nome e rode esse novo código a partir do código que passei. Exemplo, se você nomear o novo código como Sub ArrumaNome(), então acrescente ao código que passei a linha em vermelho conforme abaixo. Opcionalmente você poderá incluir outros comandos que desejar nesse novo código.

Application.DisplayAlerts = False

ArrumaNome

...

 

E sobre os extensos detalhes do seu processo que você descreveu acima (confesso que não li todos) eu sugiro que você tente resolver, e se restarem dúvidas então sugiro que você trate um caso de cada vez em novos tópicos aqui no fórum.

[FlaviaTaynara]

@osvaldomp  varei isso.

 

Muito obrigada pela ajuda e paciência.

 

Bom final de semana

 

 

[FlaviaTaynara]

Em 26/03/2020 às 09:44, osvaldomp disse:

 

Experimente:
 

Sub ReplicaDados()
 Dim ws As Worksheet, wsD As Worksheet, chb As CheckBox
  Application.ScreenUpdating = False
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name Like "Alert * (Level 2)" Then
    Set wsD = ws: Exit For
   End If
  Next ws
  wsD.[H2:L6] = ""
 For Each chb In ActiveSheet.CheckBoxes
  If chb.TopLeftCell.Column = 13 And chb = xlOn Then
   Cells(chb.TopLeftCell.Row, 8).Resize(, 5).Copy
   wsD.Cells(Rows.Count, 8).End(3)(2).PasteSpecial xlValues
   'Cells(chb.TopLeftCell.Row, 8).Resize(, 5) = "": chb = xlOff
  End If
 Next chb
 Application.ScreenUpdating = True
End Sub

obs.

1. considerei que ao rodar o código a planilha ativa será a planilha que contém os dados, no seu exemplo a planilha Alert XX.XX.XXXX

2. antes de replicar os dados o código irá limpar o intervalo H2:L6 da planilha destino (Alert XX.XX.XXXX (Level 2)); se você não quiser limpar, então comente ou exclua esta linha do código ~~~> wsD.[H2:L6] = ""

3. se após replicar os dados você quiser limpar as linhas de origem e desmarcar as Caixas de Seleção então (descomente) remova o apóstrofo ínicial desta linha do código ~~~>  'Cells(...

 

 

@osvaldomp ola, sera qu epoderia me ajudar novamente com esse codigo? 
O codigo esta funcionando corretamente, porém agora estou tentando transportar as informações em outra tabale (outro workbook) e as informações estão sendo colada no local errado da Tabela. 

 

 

[Visitante]

1. em qual dos dois arquivos está instalado o código que faz a colagem dos valores ?

2. disponibilize os dois arquivos, com o código instalado, com alguns exemplos e com o resultado desejado

[FlaviaTaynara]

@osvaldomp  Netse workbook, eu coloquei o codigo no modulo com o nome Alert_L2. 

tenho essas duas abas Alert XX.XX.XXXX e Alert *XXX* (Level 2) no meu workbook. O que quero é copiar as informações que esteja disponivel na tabela da aba Alert XX.XX.XXXX (porém apenas se o checkbox estiver selecionado na coluna M (L2)) e passar as informações para a tabela na aba Alert *XXX* (Level 2). 

 

[Visitante]

Experimente:

Sub ReplicaDados()
 Dim ws As Worksheet, wsD As Worksheet, chb As CheckBox
  Application.ScreenUpdating = False
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name Like "Alert * (Level 2)" Then
    Set wsD = ws: Exit For
   End If
  Next ws
  wsD.[H2:L3,H5:L9] = ""
 For Each chb In ActiveSheet.CheckBoxes
  If chb.TopLeftCell.Column = 13 And chb = xlOn Then
   Cells(chb.TopLeftCell.Row, 8).Resize(, 5).Copy
   If chb.TopLeftCell.Row < 4 Then
    wsD.Cells(3 + (wsD.[H2] = "") + 0, 8).PasteSpecial xlValues
   Else: wsD.Cells(5 + Application.CountA(wsD.[H5:H9]), 8).PasteSpecial xlValues
   End If
  End If
 Next chb
 Application.ScreenUpdating = True
End Sub

obs.

1. há múltiplas Caixas de Seleção sobrepostas no intervalo G5:G10, seria bom removê-las pois elas provocam aumento no tempo de execução do código

2. as Caixas de Seleção no intervalo L2:L10 devem estar contidas nos limites das respectivas células, se não o código irá copiar a linha indesejada

[FlaviaTaynara]

@osvaldomp  Muito obrigada, o codigo funcionou perfeitamente. 
porém eu estoou ainda tentando entender como o codigo funciona, seria atraves dos numeros das celulas e coluna? 
Por example tenho outra tabela que tambem preciso copiar as informações dela para outra tabela, nesse caso preciso apenas saber o numero certo de cada celula e coluna?

1- consegui deletar todas as caixas de selecao e deixar apenas 1.
2 - obrigada pela dica, nao fazia ideia. 

[Visitante]

1 hora atrás, FlaviaTaynara disse:

porém eu estoou ainda tentando entender como o codigo funciona, seria atraves dos numeros das celulas e coluna? 

Números da linha e da coluna.

 

Por example tenho outra tabela que tambem preciso copiar as informações dela para outra tabela, nesse caso preciso apenas saber o numero certo de cada celula e coluna?

É preciso colocar no código os endereços das células de origem e de destino dos dados.

 

 

[FlaviaTaynara]

18 horas atrás, osvaldomp disse:

 

@osvaldomp Obrigada. Mas infelizmente ainda nao entendi exatamente como caixa de selecao funciona para copiar e colar informações. 
Eu usei o mesmo codigo (pois as tabelas sao praticamentes iguais) e troquei as informações sobre as linhas e colunas de origem e de destino, porém nao consegui o resultado desejado. 
Neste caso o que estou fazendo de errado?  

Se consegui anexar corretamente o arquivo zipado tem todos os codigos que estou usando ate o momento neste novo woorkbook. O codigo para copiar e passar os dados estão no mudulo Alert_L2 

O senhor poderia me recomendar algum website onde eu possa mais sobre esse assunto?

(checkBox).rar (lastcheckBox).xlsx

[Visitante]

O código abaixo é uma cópia do código do post #20 com alterações para rodar no arquivo lastcheck (post #23).

As linhas que alterei estão comentadas (apóstrofo inicial) e as respectivas linhas resultantes estão logo abaixo das comentadas.

 

Sub ReplicaDadosV2()
 Dim ws As Worksheet, wsD As Worksheet, chb As CheckBox
  Application.ScreenUpdating = False
  For Each ws In ThisWorkbook.Worksheets
   If ws.Name Like "Alert * (Level 2)" Then
    Set wsD = ws: Exit For
   End If
  Next ws
  'wsD.[H2:L3,H5:L9] = ""
  wsD.[H2:M3,H5:M14] = ""
 For Each chb In ActiveSheet.CheckBoxes
  'If chb.TopLeftCell.Column = 13 And chb = xlOn Then
  If chb.TopLeftCell.Column = 14 And chb = xlOn Then
   'Cells(chb.TopLeftCell.Row, 8).Resize(, 5).Copy
   Cells(chb.TopLeftCell.Row, 8).Resize(, 6).Copy
   If chb.TopLeftCell.Row < 4 Then
    wsD.Cells(3 + (wsD.[H2] = "") + 0, 8).PasteSpecial xlValues
   'Else: wsD.Cells(5 + Application.CountA(wsD.[H5:H9]), 8).PasteSpecial xlValues
   Else: wsD.Cells(5 + Application.CountA(wsD.[H5:H14]), 8).PasteSpecial xlValues
   End If
  End If
 Next chb
 Application.ScreenUpdating = True
End Sub

11 horas atrás, FlaviaTaynara disse:

 

O senhor poderia me recomendar algum website onde eu possa mais sobre esse assunto?
 

 

Para iniciar, a senhora pode acessar o material do link abaixo.

O Sábio Google também poderá ajudar a senhora.

http://www.bertolo.pro.br/FinEst/SemanaContabeis2007/MacroExcel.pdf

[FlaviaTaynara]

@osvaldomp Obrigada. 
Ja fiz o download da apostila e irei começar a estuda-la hoje mesmo.
Gostaria de lhe pedir desculpas, por lhe encher tanto e se lhe ofendi chamandoo de senhor (confesso que meu português está um pouco enferrujado). 
Mais uma vez muito obrigada por toda ajuda e paciência.
Tenha uma otima continuação de semana e Feliz Páscoa adiantado.