Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro para copiar u...
 
Notifications
Clear all

Macro para copiar uma coluna para diversos arquivos do Excel

 
2024 - VBA & Macros
Post Recente por ArthurS 7 anos atrás
8 Posts
3 Usuários
0 Reactions
1,922 Visualizações
RSS
 ArthurS
(@arthurs)
Posts: 0
New Member
Topic starter
 

Pessoal, estive pesquisando, porem tem muita informação de importação de vários arquivos para um único arquivo.

Porem meu caso é ao contrário, tenho um arquivo padrão X que possui 2 planilhas, preciso copiar da planilha “2ª Etapa” a coluna J ou um pedaço da coluna J de J6 até J106 para diversos outros arquivos dentro de uma única pasta no windows. Estes arquivos possuem a mesma estrutura do original, com duas planilhas, preciso copiar para o mesmo local planilha “2ª Etapa” de J6 até J106 para todos os outros arquivos.

Obrigado!

 
Postado : 09/10/2017 7:06 am
 leandroxtr
(@leandroxtr)
Posts: 0
New Member
 

Bom dia ArthurS,

poste a planilha para ajudarmos melhor.

 
Postado : 09/10/2017 7:17 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Seria algo como isso..?

Sub AleVBA_Teste()
    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook
    
    'Copia a guia inteira para os arquivos
    Set sourceSheet = ActiveWorkbook.Worksheets("2ª Etapa")

    folder = "C:tempexcel"
    filename = Dir(folder & "*.xls", vbNormal)
    While Len(filename) <> 0
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()
    Wend

End Sub

Att

 
Postado : 09/10/2017 8:47 am
 ArthurS
(@arthurs)
Posts: 0
New Member
Topic starter
 

alexandrevba
Já ajudou muito, Obrigado!

Porém é quase isso.
Pois se eu rodar esta macro irá substituir a planilha inteira.
Acho que tem que colocar algo como.

Range("J6:J106").Select
Selection.Copy

e na linda filename = Dir(folder & "*.xls", vbNormal) 'substituir por xls por xlsx Excel mais novo.

Já agradeço a ajuda.

 
Postado : 09/10/2017 10:05 am
 ArthurS
(@arthurs)
Posts: 0
New Member
Topic starter
 

seria uma repetição mais ou menos assim.

Sub Macro3()
                     'arquivo de origem
    Sheets("2ª Etapa de inspeção").Select
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Open Filename:= _
        "Z:Projetos48.xlsx"
    Sheets("2ª Etapa de inspeção").Select
    Columns("J:J").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Selection.Copy
    Workbooks.Open Filename:= _
        "Z:Projetos49.xlsx"
    Sheets("2ª Etapa de inspeção").Select
    Columns("J:J").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

e assim por diante...

 
Postado : 09/10/2017 11:39 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Veja se ajuda.

Sub AleVBA_26237()
    Dim sourceSheet As Worksheet
    Dim folder As String, fileName As String
    Dim destinationWorkbook As Workbook

    Set sourceSheet = ActiveWorkbook.Worksheets("2ª Etapa")

    folder = "C:UsersAleVBADownloads"
    fileName = Dir(folder & "*.xlsx", vbNormal)
    While Len(fileName) <> 0
        Set destinationWorkbook = Workbooks.Open(folder & fileName)
        sourceSheet.Range("J6:J106").Copy Destination:=destinationWorkbook.Sheets(1).Range("J1")
        destinationWorkbook.Close True
        fileName = Dir()
    Wend

End Sub

Att

 
Postado : 10/10/2017 4:56 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia ArthurS

Tenho notado que em todas as respostas você usa a ferramenta Citação, e isso não é permitido, pois polui visualmente, use o botão Responder que fica logo abaixo da janela de resposta.

Acesse os links abaixo para ficar por dentro das regras e demais instruções do fórum, após ler, volte ao outro tópico para usar a ferramenta para marcar o tópico como Resolvido.

viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

[]s
Patropi - Moderador

 
Postado : 10/10/2017 6:18 am
 ArthurS
(@arthurs)
Posts: 0
New Member
Topic starter
 

obrigado pelas orientações.

 
Postado : 11/10/2017 3:34 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico