Optimiser code (copier data entre fichier)

Le 19/09/2016 à 20:16

Bonjour,

ma proc ouvre un fichier destination, copie des datas de ce fichier vers un fichier source.

9a marche, mais le soucis c'est que c'est long et que l'on voit les opérations malgré Application.ScreenUpdating.

Merci pour votre aide

Sub info_depuis_fichier()
    Dim fd As FileDialog
    Dim file_dest As String
    Dim path As String
    Dim file_src As String
    Dim o_existe As Integer
    Dim r_existe As Boolean

    On Error Resume Next

ActiveSheet.Range("D1") = 1

    Application.ScreenUpdating = False

    file_src = ActiveWorkbook.Name

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Title = " "
        .Filters.Add "eco", "*.xlsm"
        '.InitialFileName = "eco.xlsm"
        .AllowMultiSelect = False
    End With
    If fd.Show = -1 Then path = fd.SelectedItems(1) Else: Exit Sub

    Set fd = Nothing

    'CODE pour extraire nom fichier+extension d'un path
    file_dest = Right(path, Len(path) - InStrRev(path, "\", -1, 1))

    Workbooks.Open Filename:=path

    'FILTRE si un onglet a bien le codename "eco"
    r_existe = False
    For o_existe = 1 To Sheets.Count
        If Sheets(o_existe).CodeName = "eco" Then
            r_existe = True
        End If
    Next
    If r_existe = False Then GoTo close_fichier

Workbooks(file_dest).ActiveSheet.Range("E13:E42").Copy
Workbooks(file_src).ActiveSheet.Range("F15:F44").PasteSpecial xlValues

Workbooks(file_dest).ActiveSheet.Range("B13:B42").Copy
Workbooks(file_src).ActiveSheet.Range("E15:E44").PasteSpecial xlValues

Application.CutCopyMode = False

close_fichier:
    Workbooks(file_dest).Close savechanges = False

ActiveSheet.Range("D1") = 0
    Application.ScreenUpdating = True

End Sub
Le 20/09/2016 à 06:44

Bonjour,

J'ai apporté deux trois modifs mais je ne suis pas sûr que le gain de temps soit très significatif ? A tester pour voir :

Sub info_depuis_fichier()

    Dim fd As FileDialog
    Dim file_dest As String
    Dim path As String
    Dim file_src As String
    Dim o_existe As Integer
    Dim r_existe As Boolean

    'On Error Resume Next

    ActiveSheet.Range("D1").Value = 1

    Application.ScreenUpdating = False

    file_src = ActiveWorkbook.Name

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Filters.Clear
        .Title = " "
        .Filters.Add "eco", "*.xlsm"
        '.InitialFileName = "eco.xlsm"
       .AllowMultiSelect = False
    End With

    If fd.Show = -1 Then path = fd.SelectedItems(1) Else: Exit Sub

    Set fd = Nothing

    'CODE pour extraire nom fichier+extension d'un path
   file_dest = Right(path, Len(path) - InStrRev(path, "\", -1, 1))

    Workbooks.Open path

    'FILTRE si un onglet a bien le codename "eco"
   r_existe = False

    For o_existe = 1 To Sheets.Count
        If Sheets(o_existe).CodeName = "eco" Then
            r_existe = True
            Exit For '<--si trouvé, plus la peine d'aller plus loin
        End If
    Next

    If r_existe = False Then GoTo close_fichier

    'éviter la copie par passage des valeurs peut être un poil plus rapide ? A tester !
    Workbooks(file_src).ActiveSheet.Range("F15:F44").Value = Workbooks(file_dest).ActiveSheet.Range("E13:E42").Value
    Workbooks(file_src).ActiveSheet.Range("E15:E44").Value = Workbooks(file_dest).ActiveSheet.Range("B13:B42").Value

close_fichier:
    Workbooks(file_dest).Close False

    ActiveSheet.Range("D1").Value = 0
    Application.ScreenUpdating = True

End Sub
Le 20/09/2016 à 09:56

Bonjour Thomas, Theze, bonjour le forum,

Utliser un mot clé VBA comme nom d'un variable (Path) est fortement déconseillé... J'ai remplacé par CC (Chemin Complet)...

Une autre proposition avec, comme Theze, les mêmes doutes quant au gain de temps :

Sub info_depuis_fichier2()
Dim CS As Workbook
Dim OS As Worksheet
Dim fd As FileDialog
Dim CC As String
Dim O As Worksheet
Dim CD As Workbook
Dim OD As Worksheet

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.ActiveSheet
OS.Range("D1").Value = 1
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Clear
    .Title = " "
    .Filters.Add "eco", "*.xlsm"
    '.InitialFileName = "eco.xlsm"
    .AllowMultiSelect = False
End With
If fd.Show = -1 Then CC = fd.SelectedItems(1) Else: Exit Sub
Set fd = Nothing
Workbooks.Open CC
Set CD = ActiveWorkbook
Set OD = CD.ActiveSheet
'FILTRE si un onglet a bien le codename "eco"
On Error Resume Next
Set O = eco
If Err <> 0 Then
    Err.Clear
    GoTo close_fichier
End If
On Error GoTo 0
'éviter la copie par passage des valeurs peut être un poil plus rapide ? A tester !
OS.Range("F15:F44").Value = OD.Range("E13:E42").Value
OS.Range("E15:E44").Value = OD.Range("B13:B42").Value
close_fichier:
CD.Close False
OS.Range("D1").Value = 0
Application.ScreenUpdating = True
End Sub
Le 20/09/2016 à 16:34

Bonjour,

Utliser un mot clé VBA comme nom d'un variable (Path) est fortement déconseillé...

Tu as raison ThauThème, il est préférable de ne pas utiliser ce genre de mot mais tu remarqueras que Path estune propriété et une propriété doit obligatoirement être précédé d'un point, c'est pour cette raison que je n'ai rien changé car il ne risque absolument pas d'y avoir une mauvaise interprétation par le compilateur contrairement à Val comme on voit assez souvent alors qu'une fonction Val() existe dans VB malgré que le compilateur sait faire la différence mais encore une fois tu as raison de ne pas utiliser ce type de nom qui peut prêter à confusion !

Le 20/09/2016 à 17:12

Bonjour le fil, bonjour le forum,

Il est pas fou Theze !... Rien à dire, c'est un pro... Toujours un plaisir de le lire et d'apprendre.

Le 21/09/2016 à 10:48

Bonjour

merci à tous pour vos réponse. 9a fonctionne mais par contre j'ai toujours l'écran qui 'flash'.

C'est à dire que l'on voit toutes les opérations se dérouler à l'écran(ouverture fichier, copier,...)

Rechercher des sujets similaires à "optimiser code copier data entre fichier"