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,932 Visualizações

RSS

ArthurS

(@arthurs)

Posts: 40

Eminent 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: 447

Reputable Member

Bom dia ArthurS,

poste a planilha para ajudarmos melhor.

Se te ajudou, não se esqueça de dar um like na resposta e marcar o tópico como finalizado.

Abraços!
Leandro Cordeiro

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

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

Postado : 09/10/2017 8:47 am

ArthurS

(@arthurs)

Posts: 40

Eminent 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: 40

Eminent 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

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

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

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

Postado : 10/10/2017 6:18 am