Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Auxilio na Estrutur...
 
Notifications
Clear all

Auxilio na Estrutura importar Arquivo

 
2024 - VBA & Macros
Post Recente por caje 11 anos atrás
6 Posts
3 Usuários
0 Reactions
1,202 Visualizações
RSS
 caje
(@caje)
Posts: 97
Trusted Member
Topic starter
 

Bom dia.

Estou realizado a importação de algumas informações de outra planilha porém preciso extrair dados de 3 celulas K2,M2 e O2 estou conseguindo realizar a importação mas tenho que abrir o arquivo de importação 3 vezes. Gostaria de saber se tem alguma forma de importar os dados abrindo apenas uma unica vez o arquivo importado.

Segue abaixo o código aplicado 

ActiveSheet.Unprotect
Application.ScreenUpdating = False
   
   
Workbooks.Open Filename:= _
        ThisWorkbook.Path & "projeto_recuperacao.XLSB"
Windows("projeto_recuperacao.XLSB").Activate

'Copiar Meta do Dia
Sheets("plan1").Select
Range("K2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Workbooks.Open Filename:= _
        ThisWorkbook.Path & "projeto_recuperacao.XLSB"
Windows("projeto_recuperacao.XLSB").Activate
 'Copiar Realizados
Sheets("plan1").Select
Range("M2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


 Workbooks.Open Filename:= _
        ThisWorkbook.Path & "projeto_recuperacao.XLSB"
Windows("projeto_recuperacao.XLSB").Activate
 'Copiar Restantantes
Sheets("plan1").Select
Range("O2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     Application.CutCopyMode = False

Windows("projeto_recuperacao.XLSB").Close False
 
Postado : 11/06/2013 7:34 am
 gtsalikis
(@gtsalikis)
Posts: 2373
Noble Member
 

Vc está abrindo, ou a macro é que abre 3x?

Tente assim:

ActiveSheet.Unprotect
Application.ScreenUpdating = False
   
   
Workbooks.Open Filename:= _
        ThisWorkbook.Path & "projeto_recuperacao.XLSB"
Windows("projeto_recuperacao.XLSB").Activate

'Copiar Meta do Dia
Sheets("plan1").Select
Range("K2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Windows("projeto_recuperacao.XLSB").Activate
'Copiar Realizados
Sheets("plan1").Select
Range("M2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Windows("projeto_recuperacao.XLSB").Activate
'Copiar Restantantes
Sheets("plan1").Select
Range("O2").Select
Selection.Copy
Windows("Placar_Rec.xlsb").Activate
Sheets("plan1").Activate
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     Application.CutCopyMode = False

Windows("projeto_recuperacao.XLSB").Close False

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 11/06/2013 11:17 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Veja se auxilia

Pode ser assim:

Sub oque()

    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
       
       
    Workbooks.Open Filename:= _
            ThisWorkbook.Path & "projeto_recuperacao.XLSB"
    Windows("projeto_recuperacao.XLSB").Activate

    'Copiar Meta do Dia
    
    
    Sheets("plan1").Select
    Range("K2").Select
    Selection.Copy
    Windows("Placar_Rec.xlsb").Activate
    Sheets("plan1").Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
    Windows("projeto_recuperacao.XLSB").Activate
    
    'Copiar Realizados
    Sheets("plan1").Select
    Range("M2").Select
    Selection.Copy
    Windows("Placar_Rec.xlsb").Activate
    Sheets("plan1").Activate
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
    Windows("projeto_recuperacao.XLSB").Activate

    'Copiar Restantantes
    Sheets("plan1").Select
    Range("O2").Select
    Selection.Copy
    Windows("Placar_Rec.xlsb").Activate
    Sheets("plan1").Activate
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

         Application.CutCopyMode = False

    Windows("projeto_recuperacao.XLSB").Close False

End Sub

ou assim:

Sub doque()
    Workbooks.Open Filename:= _
            ThisWorkbook.Path & "Boi1.xls"
    'Windows("projeto_recuperacao.XLSB").Activate

'Copiar Meta do Dia
 Workbooks("Placar_Recxlsb").Sheets("Plan1").Range("B5") = Workbooks("projeto_recuperacao.xlsb").Sheets("Plan1").Range("K2").Value
 Workbooks("Placar_Recxlsb").Sheets("Plan1").Range("C5") = Workbooks("projeto_recuperacao.xlsb").Sheets("Plan1").Range("M2").Value
 Workbooks("Placar_Recxlsb").Sheets("Plan1").Range("C9") = Workbooks("projeto_recuperacao.xlsb").Sheets("Plan1").Range("O2").Value
    
    Windows("projeto_recuperacao.XLSB").Close False

End Sub

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

 
Postado : 11/06/2013 1:34 pm
 caje
(@caje)
Posts: 97
Trusted Member
Topic starter
 

Obrigado Marcelo o Problema era exatamente esse acabava abrindo a Macro 3 vezes sem a necessidade

Mas a sugestão que você deu funcionou perfeitamente.

A sugestão do Reinaldo tb funcionou obrigado.

 
Postado : 12/06/2013 5:12 am
 gtsalikis
(@gtsalikis)
Posts: 2373
Noble Member
 

Marcelo? hauhuashsuahsua

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 12/06/2013 5:17 am
 caje
(@caje)
Posts: 97
Trusted Member
Topic starter
 

Desculpa erro meu correria do dia a dia

mas Valew gtsalikis

 
Postado : 12/06/2013 12:16 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico