locked
Macro para importar .xls II RRS feed

  • Pergunta

  • Amigos,

     

    Tenho o seguinte código:

     

    Sub ImportTextFile()

        Dim DestBook As Workbook, SourceBook As Workbook
        Dim DestCell As Range
        Dim RetVal As Boolean

        ' Turn off screen updating.
        Application.ScreenUpdating = False

        ' Set object variables for the active book and active cell.
        Set DestBook = ActiveWorkbook
        Range("A5").Activate
        Set DestCell = ActiveCell
       
        ' Show the Open dialog box.
        RetVal = Application.Dialogs(xlDialogOpen).Show("*.xls")

        ' If Retval is false (Open dialog canceled), exit the procedure.
        If RetVal = False Then Exit Sub

        ' Set an object variable for the workbook containing the text file.
        Set SourceBook = ActiveWorkbook

        ' Copy the contents of the entire sheet containing the text file.
        Range(Range("B1"), Range("B1").SpecialCells(xlLastCell)).Copy

        ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.PasteSpecial Paste:=xlValues

        ' Close the book containing the text file.
        SourceBook.Close False

    End Sub

     

    Preciso que, ao importar o arquivo, ele ignore apenas a linha 7 do arquivo origem. Is it possible?

     

    Grato

     

    Sds

    Jerson

    terça-feira, 26 de fevereiro de 2008 19:49

Todas as Respostas

  • Olá,

    Tente o código com as mudanças abaixo: primeiro copia as 6 primeiras linhas e depois da oitava até a última linha preenchida.

    [ ]s

     

    Code Snippet

    Sub ImportTextFile()

        Dim DestBook As Workbook, SourceBook As Workbook
        Dim DestCell As Range
        Dim RetVal As Boolean

        ' Turn off screen updating.
        Application.ScreenUpdating = False

        ' Set object variables for the active book and active cell.
        Set DestBook = ActiveWorkbook
        Range("A5").Activate
        Set DestCell = ActiveCell
       
        ' Show the Open dialog box.
        RetVal = Application.Dialogs(xlDialogOpen).Show("*.xls")

        ' If Retval is false (Open dialog canceled), exit the procedure.
        If RetVal = False Then Exit Sub

        ' Set an object variable for the workbook containing the text file.
        Set SourceBook = ActiveWorkbook

        ' Copy the contents of the first six lines of the sheet containing the text file.
       
        'Last filled column in the SourceBook file
        LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
       
        'Last filled row in the SourceBook file
        LastLine = Cells(Rows.Count, 1).End(xlUp).Row
       
        Range(Cells(1, 2), Cells(6, LastColumn)).Copy
       
        ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.PasteSpecial Paste:=xlValues
       
        ' Copy the contents from the eighth line to the last line
        SourceBook.Activate
        Range(Cells(8, 2), Cells(LastLine, LastColumn)).Copy
       
        ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.PasteSpecial Paste:=xlValues

        ' Close the book containing the text file.
        SourceBook.Close False

    End Sub

     

     

     

    terça-feira, 26 de fevereiro de 2008 22:14
  • Adilson,

     

    Este código copia apenas as 7 primeiras linhas. Consegui resolver o problema adicionando o seguinte código antes de "SourceBook.Close False":

     

    Range("A7").Select

    Selection.EntireRow.Delete

     

    Mesmo assim, muito obrigado pela tentativa.

     

    Um grande abraço!

     

    Jerson

     

    quarta-feira, 27 de fevereiro de 2008 11:35
  • Jerson,

    Descobri um problema no código.

    Funciona se vc substituir as últimas linhas por:

     

        ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.Offset(6, 0).PasteSpecial Paste:=xlValues

        ' Close the book containing the text file.
        SourceBook.Close False

     

    Quando colava a última parte não estava deslocando as células para baixo, corrigi usando o OffSet.

     

    Se optar pela exclusão da linha 7 pode fazer numa única passagem usando:

    Rows(7).Delete

     

    [ ]s

     

    quarta-feira, 27 de fevereiro de 2008 12:21
  •  Adilson Soledade wrote:

     

    Funciona se vc substituir as últimas linhas por:

       

     

    Adilson,

     

    A quais últimas linhas você se refere?

     

     

    Sds

    Jerson

    quarta-feira, 27 de fevereiro de 2008 13:12
  • Sorry,

    Realmente não ficou claro.

    Segue abaixo destacadas em vermelho no código.

     

    Code Snippet

    Sub ImportTextFile()

        Dim DestBook As Workbook, SourceBook As Workbook
        Dim DestCell As Range
        Dim RetVal As Boolean

        ' Turn off screen updating.
        Application.ScreenUpdating = False

        ' Set object variables for the active book and active cell.
        Set DestBook = ActiveWorkbook
        Range("A5").Activate
        Set DestCell = ActiveCell
       
        ' Show the Open dialog box.
        RetVal = Application.Dialogs(xlDialogOpen).Show("*.xls")

        ' If Retval is false (Open dialog canceled), exit the procedure.
        If RetVal = False Then Exit Sub

        ' Set an object variable for the workbook containing the text file.
        Set SourceBook = ActiveWorkbook

        ' Copy the contents of the first six lines of the sheet containing the text file.
       
        'Last filled column in the SourceBook file
        LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
       
        'Last filled row in the SourceBook file
        LastLine = Cells(Rows.Count, 1).End(xlUp).Row
       
        'Copy the range from the cell A2 to last column sixth line
        Range(Cells(1, 2), Cells(6, LastColumn)).Copy
       
        ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.PasteSpecial Paste:=xlValues
       
        ' Copy the contents from the eighth line to the last line of the last column
        SourceBook.Activate
        Range(Cells(8, 2), Cells(LastLine, LastColumn)).Copy
       
       ' Activate the destination workbook and paste special the values
        ' from the text file.
        DestBook.Activate
        DestCell.Offset(6, 0).PasteSpecial Paste:=xlValues

        ' Close the book containing the text file.
        SourceBook.Close False


    End Sub

     

     

    []s

    quarta-feira, 27 de fevereiro de 2008 13:52
  •  Adilson Soledade wrote:

    Sorry,

    Realmente não ficou claro.

    Segue abaixo destacadas em vermelho no código.

    []s

     

    Adilson,

     

    Agora está copiando as linhas 1 a 7 duas vezes (subsequente) + a linha 8, após a segunda vez.

     

    Eu já resolvi o meu problema, conforme te informei anteriormente, portanto, fica a teu critério chegar um código que funcione.

     

     

    Um grande abraço.

     

    Jerson 

     

    quarta-feira, 27 de fevereiro de 2008 20:33
  • Beleza, meu caro.

    Fecha então o tópico que vou descobrir o que está falhando para referências futuras.

    [ ]s

    quarta-feira, 27 de fevereiro de 2008 21:30