[Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fichier

stephsteph · 24 Novembre 2014

Bonjour
J’ai un fichier (attaché) appelé test.xlsm et un autre fichier à construire appelé test2.csv (ou test1.xlsx dans un premier temps) (je met le fichier de résultat attendu en feuille 2 de test.xlsm pour mieux visualiser et faciliter les explications).
Je voudrais créer une macro qui copie les valeurs de tout le contenu de certaines colonnes de test.xlsm dans test1 à partir de la 2ème ligne (il y a des titres en 1ère ligne) et faire une double boucle avec une formule pour une colonne particulière.
Je n’ai pas eu de difficulté pour la macro automatique (inutile de la copier, mais c’est banal, elle est de toute façon dans le fichier xlsm).
Dans le détail :
* 1-Au lieu de copier la colonne 1, je voudrais remplacer à chaque ligne le contenu de la colonne de test.xlsm par un nombre incrémenté à chaque ligne à partir de 1 dans la ligne 2 de testmysql (ligne 2=1, ligne3=2, ligne4=3, etc)
(ensuite je copie-valeurs la totalité des colonnes 2,3,4 sans modif de test.xls en colonnes 2,3,4 à partir de ligne 2 dans test1.xlsx et idem pour les colonnes 6,7,8,9,10,11 vers les colonnes 5,6,7,8,9,10 (je saute une colonne), OK pas de souci
* 2- Au lieu de copier les contenus des colonnes comme avant, je commence une double boucle (c’est dur) depuis la colonne 12 tant que dans la ligne les cellules après la colonne 12 dans test.xlsm sont remplies et je crée la formule ="|"&L(i)C&="|"&L(i)C(1) &="|"&L(i)C(2) &="|"&L(i)C(3) &="|"&L(i)C(4), etc., ce qui donne la séquence «|indexaligne(i)|indexbligne(i)|indexcligne(i)|indexdligne(i)|indexeligne(i)|», etc. avec le contenu de la colonne 11 de test1.xlsx donc rempli avec la séquence « |indexaligne1|indexbligne1| », etc., puis je descend d’une ligne et je recommence jusqu’à ce qu’il n’y ait plus de ligne remplie
* 3- Quand c’est terminé j’enregistre le fichier directement au format csv avec séparateur « ; »
Mon souci c’est la double boucle du point 2 (dans la macro automatique, j’ai seulement copié le contenu d’une seule colonne).
Une autre contrainte (ce qui fait que je n’ai pas copié ma macro automatique, c'est seulement pour mémoire, car elle est trop longue à s’exécuter) c’est que le traitement total doit être rapide (car dans la vie réelle, le fichier fait près de10000 lignes et beaucoup de colonnes !).
J’ai essayé de bricoler la double boucle avec les 2 bouts suivants (trouvés sur Internet) :
Pour la formule (ci-dessus, pas codée):

Code:

range("A1:A" & [A65536].end(xlup).row)

Pour la double boucle (f pour la formule):

Code:

   ligne = 1
For n = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row
 dercol = Sheets("Feuil1").Cells(n, 256).End(xlToLeft).Column
  Sheets("Feuil2").Range("A" & ligne) = Sheets("Feuil1").Range("A" & f)
  ligne = ligne + 1
 For m = 12 To dercol
  Sheets("Feuil2").Range("A" & ligne) = Sheets("Feuil1").Range("A" & f)
   ligne = ligne + 1
 Next m
Next n

Mais je me suis pas mal emmêlée les baskets, et à la fin, je me suis dit que je partais mal car même si j’arrivais à ajouter le bon code à ma macro automatique, son exécution prendrait longtemps pour couvrir les milliers de lignes et les centaines de colonnes variablement remplis après la colonne 12.
Donc je m’en remet à votre pilotage.
J’espère que j’ai été bien claire (difficile de communiquer mais avec le fichier attaché cela devrait être limpide).
Merci de votre aide

Steph

stephsteph · 2 Décembre 2014

Re : Petite macro simple avec une double boucle sur ligne pour très gros fichier

Bonjour Bebere,

Merci beaucoup, tu es vraiment super : ton code est très clair et je n'ai eu aucun souci à l'adapter.
Le traitement a bien fonctionné aussi sur le très gros fichier.
Il y a juste un petit détail (j'ai vérifié sur le fichier test, c'est pareil).
L'incrémentation de la colonne 1 ne se fait pas.
Si tu regardes, la colonne de ton résultat en feuille 3 est identique à celle de départ dans laquelle il y a des "accidents" dans la suite de nombre.
En effet j'ai prévu cette incrémentation qui remplace mon contenu initial car je ne peux pas me permettre des erreurs dans la suite de nombre de la colonne 1.
Bon je crois qu'il s'agit d'une broutille.
Qu'en penses-tu ?

A+ Steph

Bebere · 2 Décembre 2014

Re : Petite macro simple avec une double boucle sur ligne pour très gros fichier

bonjour Steph
tu remplaces .Cells(L + i, 1) = Tbl(i, 1) par .Cells(L + i, 1) =i
i donne les index lignes de tbl de 1 à ubound(tbl,1)

stephsteph · 4 Décembre 2014

Re : Petite macro simple avec une double boucle sur ligne pour très gros fichier

Bonjour Bebere,
Merci beaucoup, cela fonctionne à merveille.
J’ai même pu copier la macro plus loin et j’ai pu ainsi faire machin1 et machin2 !
Le reste jusqu’à machin 7 sera du billard.
Super
Je te vole encore une seconde pour revenir à la 1ère macro que j’ai essayée de modifier pour ne pas avoir de copie sur la feuille 2 mais sur un nouveau fichier en recopiant des bouts de ta 2ème macro.
Cela bugge à la ligne (surlignée en jaune)

Code:

With WbDest.Worksheets("Feuil1")

Voici le code complet (je n’ai modifié que le début et les attributs suivant with)

Code:

 Sub Test2()
    Dim WbSource As Workbook, WbDest As Workbook, tbl, derl As Long, derc As Long, l As Long, c As Byte, i As Byte, Chemin As String, NomFichier As String

    Chemin = "D:\_Data\Main\Debut\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "machin.xlsx"
    '***
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        derl = .Cells.Find("*", [A1], , , 1, 2).Row
        dercol = .Cells.Find("*", [A1], , , 2, 2).Column
        tbl = .Range("A1:" & Cells(derl, dercol).Address)
        'ou si rien d'autre dans la feuille
'        tbl = .UsedRange
    End With

    For l = 1 To UBound(tbl, 1)
        tbl(l, 1) = l
        For c = 6 To 12    'colonnes 6 à 12
            Select Case c
            Case Is <= 12
                tbl(l, c - 1) = tbl(l, c): tbl(l, c) = "" 'met 6 en 5,7 en 6,8 en 7,etc
            End Select
        Next c

        For i = 13 To UBound(tbl, 2)
            If tbl(l, i) <> "" Then
                tbl(l, 11) = tbl(l, 11) & "|" & tbl(l, i) 'concatène
                tbl(l, i) = ""
            End If
        Next i

    Next l
'enlève colonnes vides
ReDim Preserve tbl(1 To UBound(tbl, 1), 1 To UBound(tbl, 2) - (dercol - 11))

    With WbDest.Worksheets("Feuil1")
        .Range("A2").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
    End With
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ActiveWorkbook.Save
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="D:\_Data\Main\Debut\machin.csv", FileFormat:=xlCSV, Local:=True, CreateBackup:=False

End Sub

Tu as sans doute une idée de mon erreur (de débutante)!

A+, Steph

Bebere · 4 Décembre 2014

Re : Petite macro simple avec une double boucle sur ligne pour très gros fichier

bonjour Steph
1.-WbDest n'est pas défini
ligne set wbdest=........'voir dans l'autre code
2.-Tu as bien une feuille qui s'appelle Feuil1 dans WbDest
si c'est toujours la 1ère feuille tu peux mettre activesheet à la place

stephsteph · 5 Décembre 2014

Re : Petite macro simple avec une double boucle sur ligne pour très gros fichier

Bonjour Bebere,

Tout est OK, c’est parfait.
Je te remercie vivement pour ton aide qui va être très utile et pour longtemps.
Cela fait plaisir de voir que des experts se bougent pour aider.
Tu l’as bien compris ces 2 macros sont essentielles pour adapter de gros fichiers Excel (que je continuerai à gérer/utiliser) dans le but de les installer dans une base (quelle qu’elle soit).
Car trop peu de gens savent (en tout cas pas moi avant de me heurter au blocage) que les bases, même si elles acceptent de très gros fichiers en terme de lignes avec des cellules très remplies, n’acceptent pas les fichiers avec trop de colonnes, remplies ou non).
Donc les 2 macros que tu as si gentiment réalisées vont :
La 1ère, concatener les colonnes variables en 1 seule pour une seule table avec seulement 12 colonnes (au lieu de 250)
La 2ème, éclater un très gros fichier à colonnes fixes très nombreuses (plus de 200), en plusieurs (pour moi 7) fichiers avec un nombre de colonnes limitées (en pratique de 20 à 30, pas plus).

Pour les forumistes qui seraient intéressés, voici les codes de :
La macro 1,

Code:

 Sub TestConcat()
    Dim WbSource As Workbook, WbDest As Workbook, tbl, derl As Long, derc As Long, l As Long, c As Byte, i As Byte, Chemin As String, NomFichier As String

    Chemin = "D:\_Data\Main\Debut\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "machin.xlsx"
    '***
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        derl = .Cells.Find("*", [A1], , , 1, 2).Row
        dercol = .Cells.Find("*", [A1], , , 2, 2).Column
        tbl = .Range("A1:" & Cells(derl, dercol).Address)
        'ou si rien d'autre dans la feuille
'        tbl = .UsedRange
    End With

    For l = 1 To UBound(tbl, 1)
        tbl(l, 1) = l
        For c = 6 To 12    'colonnes 6 à 12
            Select Case c
            Case Is <= 12
                tbl(l, c - 1) = tbl(l, c): tbl(l, c) = "" 'met 6 en 5,7 en 6,8 en 7,etc
            End Select
        Next c

        For i = 13 To UBound(tbl, 2)
            If tbl(l, i) <> "" Then
                tbl(l, 11) = tbl(l, 11) & "|" & tbl(l, i) 'concatène
                tbl(l, i) = ""
            End If
        Next i

    Next l
'enlève colonnes vides
ReDim Preserve tbl(1 To UBound(tbl, 1), 1 To UBound(tbl, 2) - (dercol - 11))
    Windows("machin.xlsx").Activate
    Set WbDest = ActiveWorkbook
    With WbDest.Worksheets("Feuil1")
        .Range("A2").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl
    End With
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ActiveWorkbook.Save
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:="D:\_Data\Main\Debut\machin.csv", FileFormat:=xlCSV, Local:=True, CreateBackup:=False

End Sub

Et le code de la macro2

Code:

Public Sub TestEclatement()
    Dim WbSource As Workbook, WbDest As Workbook, Adr As String, Tbl, MesColonnes, Chemin As String, NomFichier As String
    Dim LigneDebut As Long, i As Long, c As Long, L As Long
    '*** à adapter
    LigneDebut = 13
    MesColonnes = Array(3, 5, 7, 9, 10, 4, 12, 13, 14, 18)
    'Chemin = ThisWorkbook.Path & "\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    Chemin = "D:\_Data\Blabla\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "Machin1.xlsx"
    '***
    Application.ScreenUpdating = False

    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        Adr = DerCell(WbSource.Worksheets("Muscat")).Address
        Tbl = .Range("A" & LigneDebut, Adr)
    End With

    Workbooks.Open Filename:=Chemin & NomFichier
    Set WbDest = ActiveWorkbook

    With WbDest.Worksheets("Feuil1")
        L = .Range("A65536").End(xlUp).Row
        For i = 1 To UBound(Tbl, 1)
    '       .Cells(L + i, 1) = Tbl(i, 1) 'n'incrémente pas de 1 chaque ligne de la 1ère colonne, ne fait que copier la 1ère colonne
            .Cells(L + i, 1) = i
            For c = LBound(MesColonnes) To UBound(MesColonnes)
                .Cells(L + i, c + 2) = Tbl(i, MesColonnes(c))
            Next c
        Next i

    End With

    WbDest.Close savechanges:=True
    Application.ScreenUpdating = True
    
    '*** à adapter
    LigneDebut = 13
    MesColonnes = Array(4, 6, 7, 8, 9, 10, 4, 12, 13, 14, 18)
    'Chemin = ThisWorkbook.Path & "\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    Chemin = "D:\_Data\Blabla\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "Machin2.xlsx"
    '***
    Application.ScreenUpdating = False

    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        Adr = DerCell(WbSource.Worksheets("Muscat")).Address
        Tbl = .Range("A" & LigneDebut, Adr)
    End With

    Workbooks.Open Filename:=Chemin & NomFichier
    Set WbDest = ActiveWorkbook

    With WbDest.Worksheets("Feuil1")
        L = .Range("A65536").End(xlUp).Row
        For i = 1 To UBound(Tbl, 1)
    '       .Cells(L + i, 1) = Tbl(i, 1) 'n'incrémente pas de 1 chaque ligne de la 1ère colonne, ne fait que copier la 1ère colonne
            .Cells(L + i, 1) = i
            For c = LBound(MesColonnes) To UBound(MesColonnes)
                .Cells(L + i, c + 2) = Tbl(i, MesColonnes(c))
            Next c
        Next i

    End With

    WbDest.Close savechanges:=True
    Application.ScreenUpdating = True

End Sub

Function DerCell(Ws As Worksheet) As Range
    Dim derLi As Long, derCol As Long
    On Error GoTo fin
    derLi = Ws.Cells.Find("*", [A1], , , 1, 2).Row
    derCol = Ws.Cells.Find("*", [A1], , , 2, 2).Column
    Set DerCell = Ws.Cells(derLi, derCol)
    Exit Function
fin:
    Set DerCell = Ws.Cells(1, 1)
End Function

Encore merci 1000 fois
Je marque complètement résolu.
Steph

PS : je remercie aussi Gurgeh (mais je dois dire pour les lecteurs que contrairement à ce que j’avais cru sa macro ne marche pas, ma solution de mettre un « <= » était fausse)

Bebere · 5 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

bien Steph
à une prochaine fois

stephsteph · 9 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

Bonjour Bebere, bonjour le forum,

Je reviens sur ce fil pour un message général au forum et un petit souci pour Bebere s’il n’est pas trop loin (humour !)
Le message général c’est que pour une raison compliquée (que je ne maîtrise pas), il ne faut pas ré-enregistrer une 2ème fois le fichier csv au moment de le fermer (répondre « non »), car sinon il change le séparateur de « ; » à « , », ce qui peut poser problèmes avec certaines bases.

Le message pour Bebere est double (des broutilles) et concerne seulement la 2ème macro (testeclatement) recopiée ci-dessus.
Lorsque j’exécute la macro une deuxième fois sur le même fichier (seulement machin1xlsx), au lieu de commencer à copier à partir de la ligne 2, il copie à la fin de l’exercice précédent sans « écraser » le résultat précédent, ce qui fait que je me retrouve avec le double de lignes (et si j’exécute la macro 3 fois, c’est le triple)… bien sûr je peux vider le fichier machin1.xlsx à partir de la 2ème ligne, avant.
Contrairement à la 1ère macro qui est quasi instantannée (pour 12000 lignes) et avec une concaténation, la 2ème macro qui est bien plus simple (simple recopie) et porte sur bien moins de lignes prend 4 minutes et quand je fais les 9 fichiers machins d’affilée en séquence la durée dépasse les 30 minutes.
Bon, ce n’est pas grave mais je me demande si je ne me suis pas mélangé les pinceaux avec le positionnement des
Application.ScreenUpdating = False
Application.ScreenUpdating = True
Ou alors c’est autre chose ???

Merci

Steph

Bebere · 9 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

bonjour Steph
pour effacer voir ligne commentée efface et la suivante
il ne faut pas recopier le code il faut faire une liste avec les classeurs à traiter et faire une boucle
bien sûr si tu sais lesquels
si c'est autrement explique

Code:

Public Sub TransfertColonnes()
    Dim WbSource As Workbook, WbDest As Workbook, Adr As String, Tbl, MesColonnes, Chemin As String, NomFichier As String
    Dim LigneDebut As Long, i As Long, c As Long, L As Long
    '*** à adapter
    LigneDebut = 13
    MesColonnes = Array(3, 5, 7, 9, 10, 4, 12, 13, 14, 18)
    Chemin = ThisWorkbook.Path & "\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "MachinSteph.xlsx"
    '***
    Application.ScreenUpdating = False

    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        Adr = DerCell(WbSource.Worksheets("Muscat")).Address
        Tbl = .Range("A" & LigneDebut, Adr)
    End With

    Workbooks.Open Filename:=Chemin & NomFichier
    Set WbDest = ActiveWorkbook

    With WbDest.Worksheets("Feuil1")
        L = .Range("A65536").End(xlUp).Row
        .Range("A2:T" & L) = ""    'efface
        L = 1
        For i = 1 To UBound(Tbl, 1)
            .Cells(L + i, 1) = i
            For c = LBound(MesColonnes) To UBound(MesColonnes)
                .Cells(L + i, c + 2) = Tbl(i, MesColonnes(c))
            Next c
        Next i

    End With

    WbDest.Close savechanges:=True
    Application.ScreenUpdating = True

End Sub

stephsteph · 10 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

Merci Bebere pour la ligne de code qui efface (çà marche!).
Pour les 4 minutes c'était bien avec un seul fichier (j'ai repris ton nouveau code pour vérifier et c'est pareil).
Je ne vois pas bien comment une boucle ferait gagner du temps (le total fera 9 fois 4 = environ 36 minutes).
Je me trompe ?
Si je dois faire une boucle, comme elle est simple (pas double) je devrais y arriver avec une variable entière "x" et en l'incrémntant de 1 à 9 avec le code "for", mais c'est un peu compliqué car je devrais incrémenter MachinSteph.xlsx aussi de 1 à 9 (et aussi enregistrer aussi en csv avec l'incrémentation).
Il faudrait que cela fasse gagner beaucoup de temps (comparé à copier le code 9 fois)
A+, Steph

Bebere · 10 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

Steph
4minute pour combien de lignes
je viens de tester 6 sec pour 100 lignes
et avec le code qui suit 2 sec

Code:

Public Sub TransfertColonnes()
    Dim WbSource As Workbook, WbDest As Workbook, Adr As String, Tbl, MesColonnes, Chemin As String, NomFichier As String
    Dim LigneDebut As Long, i As Long, c As Long, L As Long, Cel As Range
    
    lngStartTimer = Timer

    
    '*** à adapter
    LigneDebut = 13
    MesColonnes = Array(3, 5, 7, 9, 10, 4, 12, 13, 14, 18)
    Chemin = ThisWorkbook.Path & "\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "MachinSteph.xlsx"
    '***
    Application.ScreenUpdating = False

    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        Adr = DerCell(WbSource.Worksheets("Muscat")).Address
        Tbl = .Range("A" & LigneDebut, Adr)
    End With

    Workbooks.Open Filename:=Chemin & NomFichier
    Set WbDest = ActiveWorkbook

    With WbDest.Worksheets("Feuil1")
        L = .Range("A65536").End(xlUp).Row
        .Range("A2:T" & L) = ""    'efface
        For L = 1 To UBound(Tbl, 1)
            Tbl(L, 1) = L
        Next
        .Range("A2").Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl


    End With

    WbDest.Close savechanges:=True
    Application.ScreenUpdating = True
MsgBox "Finished: " & Round(Timer - lngStartTimer) & " seconds"

End Sub

regarde du côté du classeur(la taille est elle normale,etc)

edit: mis le bon code pour corriger et mettre dans la feuille tbl

stephsteph · 11 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

Bonjour Bebere,

Merci de ce rabiot de temps.
Le timer permet en effet de savoir précisément et… cela fait 10 secondes ! (extra !)
Mais ce mieux est compensé par un bug car la macro ne copie plus certaines colonnes sélectionnées mais la totalité des colonnes !!!
Je me suis dit que c’est parce que tu n’avais pas recopié la fonction (code ci-après)

Code:

Dim derLi As Long, derCol As Long
    On Error GoTo fin
    derLi = Ws.Cells.Find("*", [A1], , , 1, 2).Row
    derCol = Ws.Cells.Find("*", [A1], , , 2, 2).Column
    Set DerCell = Ws.Cells(derLi, derCol)
    Exit Function
fin:
    Set DerCell = Ws.Cells(1, 1)
End Function

Je l’ai ajouté à la fin, mais non cela ne change rien.
Donc mystère.
J’ai vérifié 2 fois, au cas où, mais je ne vois sincèrement pas.
Désolée pour ces complications inattendues.
Steph
PS : j’ai copié le code du timer sur la macro précédente, et cela indique 203 secondes (donc en accord avec les 4 minutes comme j’avais indiqué) et il y a environ 1500 lignes sur environ 250 colonnes (c'est pour cela que j'éclate en 9 pour 20-30 colonnes chaque)

Bebere · 11 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

bonjour Steph
complètement oublié les colonnes,je recommence
edit:
tout est préparé avant l'ouverture de wbdest
efface et met tbl ds la feuille , enregistre et ferme

Code:

Public Sub TransfertColonnes()
    Dim WbSource As Workbook, WbDest As Workbook, Adr As String, Tbl(), MesColonnes, Chemin As String, NomFichier As String
    Dim LigneDebut As Long, i As Long, c As Long, L As Long, Cel As Range, a

    lngStartTimer = Timer


    '*** à adapter
    LigneDebut = 13
    MesColonnes = Array(3, 5, 7, 9, 10, 4, 12, 13, 14, 18)
    Chemin = ThisWorkbook.Path & "\"    'si les fichiers sont dans le même dossier ou si autre dossier "C:\MonDossier\MonSousDossier\"
    NomFichier = "MachinSteph.xlsx"
    '***
    Application.ScreenUpdating = False

    Set WbSource = ThisWorkbook

    With WbSource.Worksheets("Muscat")
        Adr = DerCell(WbSource.Worksheets("Muscat")).Address
        a = .Range("A" & LigneDebut, Adr)
    End With

    ReDim Tbl(1 To UBound(a, 1), 1 To UBound(MesColonnes) + 2)

    For c = LBound(MesColonnes) To UBound(MesColonnes)
        For L = 1 To UBound(a, 1)
                Tbl(L, 1) = L
                Tbl(L, c + 2) = a(L, MesColonnes(c))
        Next L
    Next c


    Workbooks.Open Filename:=Chemin & NomFichier
    Set WbDest = ActiveWorkbook

    With WbDest.Worksheets("Feuil1")
        L = .Range("A65536").End(xlUp).Row
        .Range("A2:T" & L) = ""    'efface
        .Range("A2").Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl
    End With

    WbDest.Close savechanges:=True
    Application.ScreenUpdating = True
    MsgBox "Finished: " & Round(Timer - lngStartTimer) & " seconds"

End Sub

stephsteph · 12 Décembre 2014

Re : [Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fic

Bonjour Bebere, bonjour le forum,

Cette fois çà marche et le temps est de 6 secondes.
Quel dégraissage! Bravos.
Merci Bebere, je t'envoie toutes mes amitiés de la région Parisienne (très gris aujourd'hui, comme en Belgique je suppute).
Vous au moins vous avez la Kriek ou la Faro pour embellir.
Pour les visiteurs du forum encore un petit point: ne pas s'inquiéter si dans le fichier destinataire s'affichent des cellules non formatées (par exemple, erreur si dans le fichier source il y a une formule avec '=' ou bien un pourcentage perdu), il suffit de formater la colonne concernée en format texte ou en format pourcentage et de refaire tourner la macro et l'affichage est correct.

Point final!

Steph

[Résolu] Petite macro simple avec une double boucle sur ligne pour très gros fichier

stephsteph

XLDnaute Occasionnel

Pièces jointes

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Bebere

XLDnaute Barbatruc

stephsteph

XLDnaute Occasionnel

Discussions similaires