I want to copy some texts from a sheet to another. For example: 01/02/2021
.
However VBA automatically convert it to 2020/01/02
. How can I stop it?
The following codes didn't work.
Example1:
sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
ws.Range("start").PasteSpecial xlPasteValues
ws.Range("start").PasteSpecial xlPasteFormats
Example2:
sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
ws.Range("start").PasteSpecial xlPasteFormulasAndNumberFormats
Example3:
sheet_1.Range("A1:A" & sheet1.Cells(1, 1).CurrentRegion.End(xlDown).row).Copy
ws.Range("start").Paste xlPaste Format:="Text" 'This causes an error
Please, try the next code. It will extract the date from the (pseudo) xls file and place it in the first column of the active sheet. Correctly formatted as date:
Sub openXLSAsTextExtractDate()
Dim sh As Worksheet, arrTXT, arrLine, arrD, arrDate, fileToOpen As String, i As Long, k As Long
Set sh = ActiveSheet 'use here the sheet you need
fileToOpen = "xls file full name" 'use here the full name of the saved xls file
'put the file content in an array splitting the read text by end of line (vbCrLf):
arrTXT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fileToOpen, 1).ReadAll, vbCrLf)
ReDim arrDate(UBound(arrTXT)) 'redim the array where the date will be kept, to have enough space for all the date values
For i = 39 To UBound(arrTXT) - 1 'iterate between the array elements, starting from the row where date data starts
arrLine = Split(arrTXT(i), vbTab) 'split the line by vbTab
arrD = Split(arrLine(0), "/") 'split the first line element (the date) by "/"
arrDate(k) = DateSerial(arrD(2), arrD(1), arrD(0)): k = k + 1 'properely format as date and fill the arrDate elements
Next i
ReDim Preserve arrDate(k - 1) 'keep only the array elements keeping data
With sh.Range("A1").Resize(UBound(arrDate) + 1, 1)
.value = Application.Transpose(arrDate) 'drop the array content
.NumberFormat = "dd/mm/yyyy" 'format the column where the date have been dropped
End With
End Sub
Edited:
You did not say anything...
So, I made a code returning the whole table (in the active sheet). Please, test it. It will take only some seconds:
Sub openXLSAsText()
Dim sh As Worksheet, arrTXT, arrLine, arrD, arrData, fileToOpen As String, i As Long, j As Long, k As Long
Set sh = ActiveSheet 'use here the sheet you need
fileToOpen = "xls file full name" 'use here the full name of the saved xls file
'put the file content in an array splitting the read text by end of line (vbCrLf):
arrTXT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fileToOpen, 1).ReadAll, vbCrLf)
ReDim arrData(1 To 10, 1 To UBound(arrTXT)) 'redim the array where the date will be kept, to have enough space for all the date values
For i = 38 To UBound(arrTXT) - 1 'iterate between the array elements, starting from the row where table header starts
arrLine = Split(arrTXT(i), vbTab) 'split the line by vbTab
k = k + 1 'increment the k variable (which will become the table row)
For j = 0 To 9
If j = 0 And k > 1 Then
arrD = Split(arrLine(j), "/") 'split the first line element (the date) by "/"
arrData(j + 1, k) = DateSerial(arrD(2), arrD(1), arrD(0)) 'propperely format as date and fill the arrDate elements
ElseIf j = 2 Or j = 3 Then
arrData(j + 1, k) = Replace(arrLine(j), ",", ".") 'correct the format for columns 3 and four (replace comma with dot)
Else
arrData(j + 1, k) = arrLine(j) 'put the rest of the column, not processed...
End If
Next j
Next i
ReDim Preserve arrData(1 To 10, 1 To k) 'keep only the array elements with data
With sh.Range("A1").Resize(UBound(arrData, 2), UBound(arrData))
.value = Application.Transpose(arrData) 'drop the array content
.EntireColumn.AutoFit 'autofit columns
.Columns(1).NumberFormat = "dd/mm/yyyy" 'format the first column
End With
MsgBox "Ready..."
End Sub