Import format par macro vers un nouveau workbook

[Delux]

Bonjour a tous,

Veuillez m'excuser pour les accents je travaille sur QWERTY.

Alors voila, j'ai une macro qui me permet de selectionner un repertoire et d'importer toutes les feuilles excel qui s'y trouvent.
Cette macro fonctionne tres bien de ce point de vue la, sauf que si les cellules sont vides des "0" apparaissent (si vous savez comment eviter cela je suis preneur).
Cependant, la macro ne m'inporte que les informations brutes (non formatees).

Ma question est donc : Peut-on modifier cette macro pour qu'elle conserve le format d'origine du fichier importe?

Sub Import_Find_Folder()

Dim Dossier As FileDialog
Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
Dossier.Show

If Dossier.SelectedItems.Count > 0 Then pfile = Dossier.SelectedItems(1) & "\" 'chemin d'acces

nfile = Dir(pfile & "*.xls") 'ou xlsx ou xlsm

i = 1 'Activation de la deuxieme ligne

Sheet1.Range("A1:AZ65000").ClearContents

Do Until nfile = ""
    Range("BA1").Formula = "=COUNTA('" & pfile & "[" & nfile & "]sheet1'!$A$1:A3000)"
    j = Int(Range("BA1")) + i - 1
    Range("A" & i & ":AZ" & j - 1) = "='" & pfile & "[" & nfile & "]sheet1'!A1"
    i = j
    nfile = Dir()
Loop

Range("BA1").Clear

With Range("A1:AZ" & Range("A65000").End(xlUp).Row)
    .Value = .Value
End With

End Sub

j'ai mis le format auquel devrait ressembler mon document apres importation en "Sheet2". Vous pouvez sauvegarder cette Sheet2 dans un nouveau workbook afin de pouvoir tester l'import.

Etant assez curieux, pourriez-vous rajouter les explications des lignes de codes en vert?

En vous remerciant par avance,

Cordialement,

Delux

 

[Delux]

Re : Import format par macro vers un nouveau workbook

Bon en fait j'ai trouve une autre solution.

Je vous la mets :

Sub Import_DST_Physical()
Dim a As Variant, Nom As String

Application.ScreenUpdating = False

Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
, "Sélection de vos fichiers excel", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select

Nom2 = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Windows(Nom).Activate
Sheet17.Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
Windows(Nom2).Close
End Sub