Multi insertion dynamique/Algorythme

[deniooo]

Bonjour, (j'ai le droit de plus dire bonjour au 5éme mess de la journée ?!)
J'ai un probléme d'algorythme. je vais tenter de vous expliquer :

J'ai plusieurs feuille.
Elles ont toutes la même forme de tableau.
Je doit toutes les résumer en un seul.
Je compte le nombre de ligne la feuille courante
Je copie les data
Je passe à la feuille de résumé
J'insére le nombre de ligne à copier
Je copie les datas
Je passe à la feuille suivante.

Or si on raisone comme ceci, j'insére au premier coups entre la ligne 3 et 4 (c'est comme ça) 33 lignes. Mais sur la feuille d'aprés, je ne veux plus insérer entre la 3 et la 4 mais entre la 36 et la 37.

Je n'arrive pas à traduire ce dynamisme dans ma fonction d'insertion. Je sais que cela dépends de 2 données, le nombre de lignes que j'insére et les lignes insérées le coup d'avant..

voici mon code :

Sub Transfo()
    Dim totalSheets As Long
    Dim nbL As Long
    Dim plage As Range
    
    'totalSheets = ActiveWorkbook.Sheets.Count
    totalSheets = 8
    
    For n = 2 To totalSheets 'boucle parcours feuilles
        MsgBox (n)
        
        ActiveWorkbook.Sheets(n).Select
        nbL = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
        
        MsgBox (nbL)
        
        Range(Cells(3, 1), Cells(nbL, 39)).Copy
        
        MsgBox ("okcopy")
        
        Sheets("Resume").Select
        
        MsgBox ("okselct")
        
        Ins (nbL)
        
        Cells(3, 1).Select
        
        MsgBox ("okelectrange")
        
        'Selection.Paste
    Next 'fin boucle
End Sub 'fin de function

Function Ins(ByVal nb As Long)

    ActiveSheet.Rows("4:" & nb & "").Insert

End Function

Une idée sur la façon de faire pour résoudre ce probléme ?!

 

[Guest]

Re : Multi insertion dynamique/Algorythme

Bonjour Deniooo,

Eh oui je dis toujours bonjour

Bon pour ta fonction qui n'en est pas une:

Sub Ins(ByVal nb As Long)
    dim derLig as long
    
    with ActiveSheet
           derLig=.Range("A" & .rows.count).end(xlup).row
          .Rows(derLig & ":" & derlig+nb-1).Insert
   end with

End Sub

Cela devrait le faire

A bientôt