Search code examples
excelvbacopy-pastepaste

Not placing the zeros


I have a TXT file, but when I insert it in my Excel it is removing the zeros and I don't know why it is happening and I tried to put the field type TEXT (but it changes it back to general) and also in my macro to put xlPasteValuesAndNumberFormats.

  Sub Get_Data_FromFile()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    
    Application.ScreenUpdating = False
    
    FileToOpen = Application.GetOpenFilename(Title:="Browser for your file & Import range", FileFilter:="Text Files (*.txt), *txt*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:U1000").Copy
        ThisWorkbook.Worksheets("Asiento único").Range("E18").PasteSpecial xlPasteValuesAndNumberFormats
        OpenBook.Close False
        
    End If
    
    Application.ScreenUpdating = True
    
End Sub

enter image description here

enter image description here


Solution

  • Import Text File

    Option Explicit
    
    Sub ImportTextFile()
        
        Const sfRow As Long = 1
        
        Const dName As String = "Asiento único"
        Const dFirstCell As String = "E18"
        Const Cols As String = "A:U"
        
        Dim msgString As String
        Dim IsSuccess As Variant
        
        Dim dwb As Workbook: Set dwb = ThisWorkbook
        Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
        Dim dfCell As Range: Set dfCell = dws.Range(dFirstCell)
        
        ' Create the FieldInfo parameter (all columns as text)
        Dim dcrg As Range: Set dcrg = dws.Columns(Cols)
        Dim dfCol As Long: dfCol = dcrg.Columns(1).Column
        Dim dlCol As Long: dlCol = dcrg.Columns(dcrg.Columns.Count).Column
        Dim cArr As Variant: ReDim cArr(0 To dlCol - dfCol)
        Dim c As Long
        For c = dfCol To dlCol
            cArr(c - dfCol) = Array(c, xlTextFormat)
        Next c
        
        Application.ScreenUpdating = False
        
        Dim FileToOpen As Variant
        FileToOpen = Application.GetOpenFilename( _
            Title:="Browser for your file & Import range", _
            FileFilter:="Text Files (*.txt), *txt*")
    
        If FileToOpen <> False Then
            
            Workbooks.OpenText _
                Filename:="C:\Test\2021\70386358\Test.txt", _
                Origin:=xlWindows, _
                StartRow:=sfRow, _
                DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=True, _
                FieldInfo:=cArr
            
            Dim swb As Workbook: Set swb = ActiveWorkbook
            Dim sws As Worksheet: Set sws = swb.Worksheets(1)
            Dim srg As Range: Set srg = Intersect(sws.UsedRange, sws.Columns(Cols))
            
            msgString = "Copied from" & vbLf & srg.Address(0, 0, , True) & vbLf
            
            srg.Copy
            dfCell.PasteSpecial xlPasteValuesAndNumberFormats
            swb.Close SaveChanges:=False
            
            dws.Activate
            msgString = msgString & "to" & vbLf _
                & ActiveWindow.Selection.Address(0, 0, , True)
            dfCell.Select
    
            IsSuccess = True
             
        End If
        
        Application.ScreenUpdating = True
        
        If IsSuccess Then
            MsgBox msgString, vbInformation
        Else
            MsgBox "You canceled.", vbExclamation
        End If
        
    End Sub