Keep value format the same

[michelernqm]

Need help- when copying values from workbooks to destination sheet, need help with keeping the same format. Example F2472 is a %, I need the macro to write it as it is in the original sheets. My code below, not sure where or what to insert to force values to return the same. Thanks in advance.

Sub t()
Dim fPath As String, fName As String, sh As Worksheet, wb As Workbook
Set sh = ThisWorkbook.Sheets("Summary")
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            On Error Resume Next
            With wb.Sheets("ALL")
                If Err.Number <> 9 Then
                    sh.Cells(Rows.Count, 1).End(xlUp)(2) = wb.Name
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = wb.Sheets("ALL").Range("B2444").Value
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 2).Resize(, 1) = wb.Sheets("ALL").Application. _
                    Transpose(Range("F2472"))
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = Application. _
                    Transpose(wb.Sheets("ALL").Range("E2472"))
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 4).Resize(, 1) = wb.Sheets("ALL").Application. _
                    Transpose(Range("D2472"))
                End If
                If Err.Number > 0 And Err.Number <> 9 Then
                    MsgBox "Error " & Err.Number & ":  " & Err.Description
                ElseIf Err.Number > 0 Then
                    MsgBox "Sheet 'list' not found in " & wb.Name, vbExclamation, "SHEET NOT FOUND"
                End If
            End With
            On Error GoTo 0
            Err.Clear
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

 

[GraH]

Maybe record a macro where you copy then paste special, values and number formats with option transpose. That should give you some inspiration.

 

[michelernqm]

Thank you! Got it to work adding the recorded macro

 

[GraH]

Well done, thank you for the feedback.