Excel como aplicar um código em qualquer arquivo que abrir

[felipe de sousa ferreira]

Boa tarde pessoal, irei explicar o funcionamento da planilha pois acredito que vocês não interpretaram da forma correta.

Eu criei um código para extrair e colar determinadas colunas para diferentes pastas de trabalho no Excel, ou seja utilizarei duas planilhas. O código é executado quando clico sobre a user form (ATUALIZAR) assim acontece os seguintes comando:

1º: A planilha seleciona a ultima linha preenchida, logo em seguida pula uma linha.

2º: logo em seguida apresenta a pasta explorer para eu selecionar o arquivo desejado para exportar as informações desejadas

3º: Após selecionar o arquivo desejado, o mesmo copia e cola as informações desejadas na pasta de trabalho "PROJETO_ANALISE FAC CENTRO"

 

O problema é, quando eu estava criando o código eu usei uma planilha como base chamada " Atividades-CO FAC 07 05 18 ", assim o código só funciona selecionando apenas esta planilha. O correto seria funcionar em qualquer arquivo que eu selecionar. Como resolver isso ? o código está logo abaixo.

 

Sub DESCER_LINHA()
'
' TESTE Macro
'

'
    Range("A65536").End(xlUp).Select
   ActiveSheet.Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
   Dim importFileName As Variant
Dim importWorkbook As Workbook
Dim importSheet As Worksheet
Dim importRange As Range
       
    'mostre o diálogo aberto do arquivo
    importFileName = Application.GetOpenFilename(FileFilter:="Arquivo do Excel (*.xml; *.xlsx), *.xls;*.xlsx", Title:="Escolha um arquivo do Excel")
    
    ' se o usuário pressionou cancelar buton: exit
    If importFileName = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
         ' se o usuário selecionou um arquivo excel, abra-o
         Set importWorkbook = Application.Workbooks.Open(importFileName)
         Set importSheet = importWorkbook.Worksheets(1)
         
         ' processo de exportação das colunas desejadas
         
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "FRANCA"
    Range("A2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-39
    ActiveWindow.ScrollRow = 1137
    ActiveWindow.ScrollRow = 1129
    ActiveWindow.ScrollRow = 1052
    ActiveWindow.ScrollRow = 1016
    ActiveWindow.ScrollRow = 852
    ActiveWindow.ScrollRow = 711
    ActiveWindow.ScrollRow = 667
    ActiveWindow.ScrollRow = 460
    ActiveWindow.ScrollRow = 440
    ActiveWindow.ScrollRow = 319
    ActiveWindow.ScrollRow = 291
    ActiveWindow.ScrollRow = 205
    ActiveWindow.ScrollRow = 172
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 1
    Range("A2:C1203,F2").Select
    Range("F2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Range("A2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-15
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    ActiveSheet.Paste
    Range("D2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    Range("D2125").Select
    ActiveSheet.Paste
    Range("E2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("H2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    Range("E2125").Select
    ActiveSheet.Paste
    Range("G2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    ActiveSheet.Paste
    Range("H2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("Y2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    ActiveSheet.Paste
    Range("I2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("AI2:AJ2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    ActiveSheet.Paste
    Range("K2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("AN2:AP2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    Range("K2125").Select
    ActiveSheet.Paste
    Range("N2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("AR2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    Range("N2125").Select
    ActiveSheet.Paste
    Range("O2125").Select
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    Range("AZ2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Windows("PROJETO_ANALISE FAC CENTRO.xlsm").Activate
    Range("O2125").Select
    ActiveSheet.Paste
    Windows("Atividades-CO_FAC_07_05_18.xml").Activate
    ActiveWindow.Close
End Sub

 

 

[Patropi]

@felipe de sousa ferreira

 

Não sei se entendi corretamente, mas se você quer que as macros funcionem em qualquer pasta de trabalho do Excel, basta salvá-las na Pasta de trabalho Pessoal de Macros.

 

Veja um tutorial no link abaixo:

 

https://support.office.com/pt-br/article/criar-e-salvar-todas-as-macros-em-uma-única-pasta-de-trabalho-aa439b90-f836-4381-97f0-6e4c3f5ee566

 

Se foi útil, clique em Curtir.

 

Dê retorno.

 

[]s

[CasaDoHardware]

Tente trocar isso

 

Windows("Atividades-CO_FAC_07_05_18.xml").Activate

 

Por isso

 importFileName.Activate


Tudo que você encontrar no codigo semelhante a isso

 

 ActiveWindow.SmallScroll Down:=-39
    ActiveWindow.ScrollRow = 1137
    ActiveWindow.ScrollRow = 1129

 

Pode ser apagado.

 

adicionado 2 minutos depois

porque abriu outro topico?

Não entendi o motivo?

 

[felipe de sousa ferreira]

@CasaDoHardware Depois de algumas modificações percebi que tinha um erro no código, por isso apresentava um certo erro. Após as alterações recomendadas, o código rodou ! Obrigado pela ajuda amigo. #Gratidãototal