Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Rotina não atualiza...
 
Notifications
Clear all

Rotina não atualiza nome de pasta via inputbox

 
2024 - VBA & Macros
Post Recente por wangchuk 10 anos atrás
5 Posts
3 Usuários
0 Reactions
1,155 Visualizações
RSS
 wangchuk
(@wangchuk)
Posts: 5
Active Member
Topic starter
 

Boa tarde!

Por favor,

Preciso corrigir uma rotina em VBA Excel que prevê a cópia de conteúdos de ranges específicos de uma pasta, para os ranges equivalentes em outra pasta, da seguinte forma:

- Partindo da Pasta "A" (que contém a rotina) uma pasta é aberta via inputbox. Vamos chamá-la de PASTA B

- Em seguida, os conteúdos desta pasta são selecionados e copiados - ranges C2:C6 e E8:H19 - e colados (somente valores) nos mesmos ranges da Pasta "A".

- Pasta B é fechada.

Não estou conseguindo, ao digitar o nome de uma nova pasta no inputbox (PASTA C por exemplo), que a rotina a mantenha ativa para todo o processo. Assim, ela só atualiza o primeiro range e mantém os valores da pasta usada anteriormente, no segundo range.

A rotina mambembe que eu fiz (listada abaixo) atualiza o primeiro range, mas como não atualiza o nome do arquivo, conforme a mudança no inputbox, gerando erro em tempo de execução 9.

Fui claro?

Podem me ajudar?

Desde já, agradeço

Wangchuk

===============================================================

Sub Macro1()

Dim Arquivo As String

Arquivo = InputBox("Digite o nome do arquivo.", "Nome do ARQUIVO.")

If Arquivo = "" Then
MsgBox "Favor digitar o nome do arquivo.", vbInformation + vbOKOnly, "Atenção!"
Arquivo = InputBox("Digite o nome do arquivo.", "Nome do ARQUIVO.")
End If

Workbooks.Open Filename:="E:MEU CAMINHO" & Arquivo & ".xlsx"

Range("C2:C6").Select
Selection.Copy
Windows("PASTA A.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PASTA B.xlsx").Activate ==============>>aqui deveria apontar para a Pasta C conforme entrada no inputbox. A rotina não está atualizando
Application.CutCopyMode = False
Range("E8:H19").Select
Selection.Copy
Windows("PASTA A.xlsm").Activate
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PASTA B.xlsx").Activate ==============>> Idem
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

 
Postado : 27/11/2014 1:49 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Não testado!!

Sub naoTestado()
     Dim wkbCrntWorkBook As Workbook
     Dim wkbSourceBook As Workbook
    
     Dim rngSourceRange As Range
     Dim rngDestination As Range
    
     Set wkbCrntWorkBook = ActiveWorkbook
    
     With Application.FileDialog(msoFileDialogOpen)
         .Filters.Clear
         .Filters.Add "Excel 2002-03", "*.xls", 1
         .Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
         .AllowMultiSelect = False
         .Show
        
         If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = wkbSourceBook.Sheets(1).Range(Application.InputBox(prompt:="Selecione o Intervalo", Title:="Intervalo", Default:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8))
            Set rngDestination = wkbCrntWrkbBook.Sheets(1).Range(Application.InputBox(prompt:="Selecione celula destino", Title:="Colar em", Default:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8))
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireSelection.AutoFit
            wkbSourceBook.Close False
         End If
     End With
 End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 27/11/2014 1:59 pm
 wangchuk
(@wangchuk)
Posts: 5
Active Member
Topic starter
 

Boa noite, Alexandre!

Primeiramente, muito obrigado pela pronta resposta.

Olhei seu código e o testei. A ideia não é bem essa.

A ideia geral é fazer com que apenas o arquivo de origem seja carregado ou ativado (quer via inputbox ou quadro Abrir), clicar ok ou abrir e mais nada.

Os conteúdos (que sempre estarão no mesmo intervalo) seriam selecionados, copiados e colados na pasta de destino, nas células que também serão sempre as mesmas.

Com aquele meu código conseguia isso, só que quando eu testava com outro arquivo ele só atualizava o primeiro intervalo. O segundo mantinha o conteúdo do arquivo usado antes.

O que preciso descobrir é como fazer para que, ao escolher um novo arquivo de origem, todos os intervalos do destino sejam atualizados.

Me ajuda nessa?

Grande abraço!

Wangchuk

 
Postado : 27/11/2014 5:56 pm
Reinaldo
 Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Veja se auxilia

Sub Macro1()
Dim Arquivo As String, ArqBase As String

Arquivo = InputBox("Digite o nome do arquivo.", "Nome do ARQUIVO.")

If Arquivo = "" Then
    MsgBox "Favor digitar o nome do arquivo.", vbInformation + vbOKOnly, "Atenção!"
    Arquivo = InputBox("Digite o nome do arquivo.", "Nome do ARQUIVO.")
End If

Arquivo = Arquivo & ".xlsx"
ArqBase = ThisWorkbook.Name
Workbooks.Open Filename:="E:MEU CAMINHO" & Arquivo

Range("C2:C6").Copy
Windows(ArqBase).Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arquivo).Activate
Application.CutCopyMode = False
Range("E8:H19").Copy
Windows(ArqBase).Activate
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arquivo).Activate
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

Reinaldo

 
Postado : 28/11/2014 8:05 am
 wangchuk
(@wangchuk)
Posts: 5
Active Member
Topic starter
 

Muito obrigado, Reinaldo!

Exatamente isso!

Realmente estou enferrujado....

Agradeço, também, ao Alexandre, pelo interesse.

Sucesso à todos!

Abraço

Wangchuk

 
Postado : 28/11/2014 4:08 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico