Notifications
Clear all

Copiar intervalo de uma planilha

2 Posts
2 Usuários
0 Reactions
1,415 Visualizações
 cts
(@cts)
Posts: 6
Active Member
Topic starter
 

Boa tarde!!

Tenho 10 arquivos xlsx, preciso desenvolver um código vba para abrir cada um desses arquivos, selecionar o intervalo da planilha e copiar em um novo arquivo xls. para depois que terminar a copia criar uma tabela dinâmica. Se alguém tiver uma ideia de como posso fazer isso, agradeço

Grato.

 
Postado : 16/12/2019 1:06 pm
(@laerteb)
Posts: 67
Trusted Member
 

Boa tarde, cts

Alguns adendos referente este Fórum e aos Tópicos que você abre:

- 1º quando abrir um tópico, por gentileza não abandoná-lo; caso já tenha resolvido a sua questão
informe no seu Tópico e coloque o resultado; pois muitos usuários podem precisar pesquisar
e até mesmo utilizá-lo (pois a mesma dúvida pode ser igual ou parecida a de outros). Para
exemplo me refiro ao Tópico que tu abriste e deixou abandonado sem resposta, segue abaixo o link:
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=32185

- 2º Sempre agradeça o pessoal que está tentando te ajudar (clicando na mãozinha), mesmo que não
resolva por completo, pois todos aqui só fazemos isso em nosso tempo livre, e com os agradecimentos
nos incentiva a continuar ajudando :);

- 3º Como já tinha mencionado anteriormente (como no tópico acima citado) veja a observação em azul
abaixo:

Como todos aqui, temos compromissos e não temos muito tempo para criar um arquivo do zero, pois
ajudamos somente no nosso tempo livre... é muito importante sempre anexar uma planilha de
exemplo com dados (fictícios) e que não seja o projeto inteiro ; explicando com as informações
necessárias para alcançar o seu objetivo, desta forma podemos ajudá-lo com maior rapidez e
eficácia (a maioria nem olharia este Tópico sem um arquivo exemplo, pois existe muitas
"variáveis" que podem impossibilitar o sucesso parcial ou total da solução proposta,se não tiver um
arquivo exemplo que for disponibilizado)
😉 ..

Como tu não colocou um arquivo exemplo (sempre informe um), estou informando alguns códigos que podem te
ajudar no desenvolvimento do seu projeto que citou na mensagem acima (terá que adaptá-los ao seu projeto):

Abaixo código que abre o arquivo Excel usando a janela do navegador no endereço "BibliotecasDocumentos";
pode ser colocado em um módulo:

Sub AbreArquivo1()

Dim xFilePath As String
Dim xObjFD As FileDialog

 Set xObjFD = Application.FileDialog(msoFileDialogFilePicker)

   With xObjFD
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
        .Show

        If .SelectedItems.Count > 0 Then
            xFilePath = .SelectedItems.Item(1)

        Else
            Exit Sub

        End If

     End With

    Workbooks.Open xFilePath  'aqui abre o arquivo selecionado
    
End Sub

Agora abaixo o código que abre um inputbox, tu digita a letra da coluna + a linha que
quer selecionar e ele já copia a seleção e cola no arquivo excel "C:Arquivos Copiados - 2019-12.xlsx"
(este é só um exemplo - crie um arquivo para a colagem dos dados selecionados - e este cola sempre
abaixo da última linha preenchida) - este código está integrado a um commandbutton criado no arquivo
Excel Principal (que não contém nenhum dados é somente para executar os comandos de seleção, copia e
de abrir outros arquivos Excel e salvar no arquivo Excel que irá gravar os seus dados):

Private Sub CommandButton1_Click()

 Dim x As Variant
 Dim WNew As Workbook
 Dim wsc As Workbook

   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Application.DisplayAlerts = False

' ********************************************

 Call AbreArquivo1
 
 On Error Resume Next

 Set WNew = ActiveWorkbook
 Set WNew = ActiveSheet
  
'**********************************************************
Set x = Application.InputBox _
(Prompt:="- Escolha as linhas, " & _
"selecionando-as." & vbCrLf & vbCrLf & "Pode-se escolher várias linhas " & _
"- Para selecionar mais de uma linha, " & vbCrLf & _
"digite a coluna com o nº da linha colocando ponto e virgula" & vbCrLf & _
"digitando na sequencia a próxima coluna com o nº da linha, " & vbCrLf & _
"e assim por diante. ", _
Title:=SELEÇÃO, Type:=8)

If Not x Is Nothing Then

MsgBox "As linhas foram selecionadas e serão coladas!" & vbCrLf & _
x.Address, vbExclamation, msgTitulo
x.EntireRow.Select
x.EntireRow.Copy

' ******************************************
 Set wsc = Workbooks.Open("C:Arquivos Copiados - 2019-12.xlsx")
  wsc.Sheets(1).Select
  wsc.Sheets(1).Range("A1").Select
  
 Do
  If Not (IsEmpty(ActiveCell)) Then
   ActiveCell.Offset(1, 0).Select
  End If
  
 Loop Until IsEmpty(ActiveCell) = True
   ActiveCell.PasteSpecial Paste:=xlValues
  
 Application.DisplayAlerts = False

  wsc.SaveAs WNew.Path & "Arquivos Copiados - " & Year(Date) & "-" & Month(Date)
  wsc.Close savechanges = True

 Application.DisplayAlerts = True
  
End If

' *********************************************

 Application.CutCopyMode = False
 Set x = Nothing
 Set WNew = Nothing
 Set wsc = Nothing

   Application.EnableEvents = True
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

End Sub

Com esses códigos tu podes abrir quantos arquivos Excel quiser e selecionar as linhas que desejar
copiar para o arquivo Excel de "Destino" :D

Por gentileza, verifique se está de acordo com o que solicitou :)

Qualquer dúvida estamos aqui para ajudar ;)

Aguardando sua resposta e seu Feed Back(é muito importante)... se foi útil, não esqueça de clicar na "mãozinha" :D

LaerteB :D

 
Postado : 17/12/2019 3:09 pm