XL 2010 Copier/Coller tableau par ligne

Legolas

XLDnaute Occasionnel
Bonjour,

Je cherche à optimiser un code afin d'accélérer le traitement de ma macro.
Le but est de rapatrier un tableau (entre 500 et 3000 lignes selon le mois en cours) dans un autre fichier.
Le problème est que le fichier destination peut avoir des lignes supplémentaires insérées (je ne peux donc pas bêtement copier/coller l'ensemble)

Aujourd'hui, je fais :
Code:
Sub importer_base()


    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    ActiveSheet.DisplayPageBreaks = False

    Dim i, j, k, l, ligne, nb_col As Integer
    Dim tabS(0 To 10000, 0 To 100)
 
    fichier_metier = ThisWorkbook.Name
     
    lien = Cells(1, 10)
    fichier = "Suivi_GO-BID.xlsm"
 
    Application.Workbooks.Open Filename:=lien & fichier, ReadOnly:=True
 
    i = 3
    nb_col = 20
    k = 0
    l = 0
    Do While Cells(i, 1) <> ""
        For j = 1 To nb_col - 1
            tabS(k, j - 1) = Cells(i, j)
        Next j
        k = k + 1
        i = i + 1
    Loop
 
    Workbooks(fichier).Close savechanges:=False
 
    Workbooks(fichier_metier).Activate
    With Sheets("Suivi_métier")
        Set plage = .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
     
        i = 0
        Do While tabS(i, 0) <> ""
            ligne = 0
            If IsError(Application.Match(tabS(i, 0), plage, 0)) Then
                ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Else
                ligne = Application.Match(tabS(i, 0), plage, 0) + 1
            End If

            For j = 1 To nb_col
                .Cells(ligne, j) = tabS(i, j - 1)
            Next j
           
            i = i + 1
        Loop
    End With
     
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

Ce qui prend du temps c'est la boucle :
Code:
    For j = 1 To nb_col
                .Cells(ligne, j) = tabS(i, j - 1)
            Next j

Est-il possible de la remplacer par quelque chose du style ?
Code:
Range(Cells(ligne, 1), Cells(ligne, nb_col)) = tabS[i]
J'ai testé et cela ne fonctionne pas...

Merci pour votre aide.

Nicolas
 
Dernière édition:

gosselien

XLDnaute Barbatruc
Bonjour,

Tu risques d'avoir une demande de fichier exemple... pour voir ta structure de fichier :)
Moi, je suivrai à mon retour, je dois quitter un moment, mais sans fichier c'est un peu Madame IRMA la voyante avec sa boule de crystal :)

P.
 

Legolas

XLDnaute Occasionnel
Je peux mettre le ficher destination (vidé de toutes les données car confidentielles) si ça aide.
Les colonnes 1 à 20 sont issues du fichier source (que je ne peux pas insérer ici) qui ont exactement le même format. Les colonnes après 20 sont à la disposition des utilisateurs du fichier (pour faire des calculs et des indicateurs par exemple).
Le transfert consiste à mettre à jour les colonnes à 1 à 20 du fichier destination avec les données du fichier source.
Le problème est que le fichier destination peut avoir des lignes supplémentaires par rapport au fichier source.
 

Pièces jointes

  • Suivi_métier.xlsm
    52.7 KB · Affichages: 39

Legolas

XLDnaute Occasionnel
bonjour,

- pourquoi ne pas trouver la dernière ligne utilisée de ta feuille destination et
- y copier ton tableau
http://boisgontierj.free.fr/
rubrique tableaux / transférer tableau dans range

Malheureusement, cela ne correspond pas à ce que je souhaite faire.
Je dois modifier les données du tableau destination avec celles du tableau source. Et je n'ai pas trouvé de moyen que faire cellule par cellule. Je ne trouve pas de solution pour faire ligne à ligne...
 

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG