none
macro para abrir outros arquivos, copiar e colar linhas uma embaixo da outra RRS feed

  • Pergunta

  • Preciso de uma macro que faça o seguinte:

    No arquivo "Total", aperto um botão que me abra uma dialog box pedindo pra localizar o arquivo que eu quero. Quando seleciono este arquivo, a macro copia 10 linhas dele e cola de volta no arquivo "Total". Depois disso, ainda seleciono mais 5 arquivos e preciso que, ao colar as novas linhas no arquivo "Total", elas fiquem embaixo da última linha preenchida, e assim por diante. (O número de linhas muda toda semana)

    Como posso fazer isso?

    Muito obrigada!

    quarta-feira, 25 de agosto de 2010 17:56

Respostas

  • Se quiser buscar informações em 6 planilhas no total,

    Sub BuscarInformações()
      
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim lngRemoto As Long
      Dim lngEu As Long
      Dim lngCounter As Long
      
      Application.ScreenUpdating = False
      
      With ActiveSheet
        For lngCounter = 1 To 6
          Set wb = Workbooks.Open(Application.GetOpenFilename)
          Set ws = wb.Sheets(1)
          
          lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
          lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
          
          ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
          wb.Close False
        Next lngCounter
      End With
    
      Set ws = Nothing
      Set wb = Nothing
      Application.ScreenUpdating = True
    
    End Sub

    quinta-feira, 26 de agosto de 2010 01:10
    Moderador
  • Sub BuscarInformações()
      
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim lngRemoto As Long
      Dim lngEu As Long
      
      Application.ScreenUpdating = False
      
      With ActiveSheet
      
        Set wb = Workbooks.Open(Application.GetOpenFilename)
        Set ws = wb.Sheets(1)
        
        lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
        lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
    
      End With
      
      wb.Close False
      Set ws = Nothing
      Set wb = Nothing
    
      Application.ScreenUpdating = True
    
    End Sub
    quinta-feira, 26 de agosto de 2010 01:04
    Moderador

Todas as Respostas

  • Sub BuscarInformações()
      
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim lngRemoto As Long
      Dim lngEu As Long
      
      Application.ScreenUpdating = False
      
      With ActiveSheet
      
        Set wb = Workbooks.Open(Application.GetOpenFilename)
        Set ws = wb.Sheets(1)
        
        lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
        lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
    
      End With
      
      wb.Close False
      Set ws = Nothing
      Set wb = Nothing
    
      Application.ScreenUpdating = True
    
    End Sub
    quinta-feira, 26 de agosto de 2010 01:04
    Moderador
  • Se quiser buscar informações em 6 planilhas no total,

    Sub BuscarInformações()
      
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim lngRemoto As Long
      Dim lngEu As Long
      Dim lngCounter As Long
      
      Application.ScreenUpdating = False
      
      With ActiveSheet
        For lngCounter = 1 To 6
          Set wb = Workbooks.Open(Application.GetOpenFilename)
          Set ws = wb.Sheets(1)
          
          lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
          lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
          
          ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
          wb.Close False
        Next lngCounter
      End With
    
      Set ws = Nothing
      Set wb = Nothing
      Application.ScreenUpdating = True
    
    End Sub

    quinta-feira, 26 de agosto de 2010 01:10
    Moderador
  • Muito obrigada, Felipe, consegui!
    quinta-feira, 26 de agosto de 2010 18:06
  • Galera.. tava com a mesma dúvida aqui..adaptei o código as minhas necessidades e funfou..

    só um detalhe que não estou conseguindo entender..

    quando ele faz a cópia, uma das coluna que contem "quantidades" está, no arquivo de origem, em decimal passa a ser milhar na planilha de cópia.. tipo, na origem está 10,3 e dai na cópia aparece 10300..

    detalhe que isto está acontecendo apenas nesta coluna.

    nas outras colunas, que  tambem tem números, aparece o valor correto..

    alguma sugestão?? 

    valeu

    terça-feira, 15 de outubro de 2013 23:46
  • Guilherme,

    Este tópico está encerrado. Sugiro que crie um novo tópico com sua pergunta e referencie o link desta postagem, explicando sua dúvida. Obrigado.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 17 de outubro de 2013 10:01
    Moderador