Vba to keep leading zero when copying array

[thardin]

This code works 99% of the time, but just has one problem. When It copies and pastes a cell with a number that starts with 0, it doesn't keep the zero.
I need the zero in there for the rest of the macro to run accurately.
How do I fix this?
I think it's this line: Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws1Row_Start).Resize(UBound(Ary), 2).Value = Ary

Sub Test()

'
'
    Dim ws1 As String, ws2 As String, ws3 As String
    Dim strFullDate As String, strFullDate2 As String, strFullDate3 As String
    Dim lr As Long
    Dim S As String
    Dim Ary As Variant
    Dim Fname As String, DestinationFileName As String
    Dim SourceFileName As String
    
    strFullDate = Format(Date, "yyyymmdd")
    strFullDate2 = Format(Date, "mm.dd.yy")
    strFullDate3 = Format(Date, "mmddyy")
    SourceFileName = strFullDate & ".....Restrictions Voids " & MY_INITIALS & " " & strFullDate2 & ".xlsx"
    DestinationFileName = "...UBTREJ" & strFullDate3 & ".xlsx"

        
    Workbooks(SourceFileName).Activate

    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3

    
    '   Find last row in column U with data
    lr = Cells(Rows.Count, "U").End(xlUp).row
        
    
    If WorksheetExists(ws1) Then
        '   Copy data
        ws1Row_Start = 2
        ws1Row_Count = Worksheets(ws1).Cells(Rows.Count, "U").End(xlUp).row - 3
        With Worksheets(ws1).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
       
        End With
        'Pastes data in destination file in cell A2 Data:
          
        Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws1Row_Start).Resize(UBound(Ary), 2).Value = Ary
        
    End If
        
    
    If WorksheetExists(ws2) Then
        '   Copy data
            ws2Row_Start = ws1Row_Start + ws1Row_Count
                
    ws2Row_Count = Worksheets(ws2).Cells(Rows.Count, "U").End(xlUp).row - 3
        With Worksheets(ws2).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
       'Pastes data in destination file under WS1 Data:
       Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws2Row_Start).Resize(UBound(Ary), 2).Value = Ary
    
     End If

    If WorksheetExists(ws3) Then
     '   Copy data
        ws3Row_Count = Worksheets(ws3).Cells(Rows.Count, "U").End(xlUp).row - 3
            ws3Row_Start = ws2Row_Start + ws2Row_Count
        With Worksheets(ws3).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
        'pastes data in destination file under the WS1 and WS2 data:
        Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws3Row_Start).Resize(UBound(Ary), 2).Value = Ary
          
    End If
    
    Workbooks(DestinationFileName).Activate
        lr = Cells(Rows.Count, "A").End(xlUp).row
        Range("A2:A" & lr).Copy
  
    'Saving Numbers to Notepad on Desktop:
    Workbooks.Add
    '
    Range("A1").PasteSpecial Paste:=xlPasteValues
    '
    ActiveWorkbook.SaveAs FileName:=MY_DESKTOP & "Notepad.txt", FileFormat:=xlText
    ActiveWorkbook.Close False
    With ActiveWindow
        .WindowState = xlNormal
        .Width = 400
        .Height = 591.75
        .Left = 1000
        .Top = 0
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


End Sub

 

[BSALV]

make the destionation cells in numberformat "text" before adding the values
or you have to add a ' character in front of each number

 With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws3Row_Start).Resize(UBound(Ary), 2)
               .NumberFormat = "@"                              'format text
               .Value = Ary
          End With