Cells format change after copy and paste data

[marreco]

Hi

I'm going creazy, because when SAP export to excel file, I don't know why, the file is created with the extension XLS

I need copy data in One tab("cobaia") from file "cobaia.XLS" and paste into file "PasteHere.xlsm"

When I copy data by VBA, something wrong happening, if you look in columns(T,W,X,Y,Z,AA,AC,AD,AE,AF,AG,AI,AJ,AK,AL,AN,AO,AP), the value came with "error" (spaces, not number)

I'm using this code below.

Sub Stole_this_Code_from_davesexcel()
'http://www.excelforum.com/excel-programming-vba-macros/1063028-copy-related-cells-from-different-workbooks-to-same-workbook.html
'Sorry I stole this code from davesexcel
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "C:\Users\monica\Downloads\Monica\"
    MyFile = Dir(MyDir & "cobaia.XLS")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        With Worksheets("cobaia")
            Rws = .Cells(Rows.Count, "C").End(xlUp).Row
            Set Rng = Range(.Cells(1, 1), .Cells(Rws, 44))
            Rng.Copy Wb.Worksheets("Relatorio").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close True
        End With
        MyFile = Dir()
    Loop

End Sub

My files size 72Mb, because this, I paste files on GoogleDrive:
https://drive.google.com/drive/folde...fE?usp=sharing

Thank you!!

[dflak]

When you do a full copy and paste, you get everything, formats, formulas, conditional formatting, validations, etc.

If you want to preserve the formats in the workbook being copied into, change this line:

Rng.Copy Wb.Worksheets("Relatorio").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

To this:

Rng.Copy 
Wb.Worksheets("Relatorio").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).pastespecial xlpastevalues

[marreco]

Hi dflank

I need test this in my job tomorrow, anyway, before I mark as solved, can you help with more one task?

Sub Stole_this_Code_from_davesexcel()
'http://www.excelforum.com/excel-programming-vba-macros/1063028-copy-related-cells-from-different-workbooks-to-same-workbook.html
'Sorry I stole this code from davesexcel
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "C:\Users\mareco\Downloads\"
    MyFile = Dir(MyDir & "cobaia.XLS")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        With Worksheets("cobaia")
            Rws = .Cells(Rows.Count, "C").End(xlUp).Row
            Set Rng = Range(.Cells(1, 1), .Cells(Rws, 44))
            Rng.Copy Wb.Worksheets("Relatorio").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close True
        End With
        MyFile = Dir()
    Loop
    '----- help me with too, please? ------
    With Worksheets("Relatorio")
    'After paste data, I need do little thing...
    'How to remove all blank rows and keep one single header(Nş NF|Data doc.|Dt.lçto.|CN|Cat. Nota Fiscal|Estornado  ...Etc)?
        .Range("A:B").Delete
        .Range("A1:A" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns.AutoFit
    End With
End Sub

Thank you!!

[marreco]

Hi

I do my test, but it does not work, look at my attachment.
The numbers is paste not like number (in up left corner of cell, show green simbol).

Is there fast way todo this?
Code below solve, but I need some more fast.

Public Sub Change_to_Number()
'I have only 2 days of data, this mean 80138 rows
'Code below salve, but take aa long time.
  Dim rngCelula As Range
  For Each rngCelula In Range("U2:AN80000") 'Selection
    rngCelula.FormulaLocal = rngCelula.Value
  Next rngCelula
End Sub

Thank you!!