Stocker des valeurs dans un tableau à dimension dynamique

arthurho

XLDnaute Junior
Bonjour,

J'ai réalisé une macro qui parcours des valeurs dans une colonne d'une feuille, je voudrais stocker certaines de ces valeurs dans une Range ou un tableau de manière dynamique.
Le code utilisé est le suivant :
Code:
Sub LireFichier3()


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Dim Z1 As String, Z2 As String, LgSource As Range
Dim l As Long, FDM_tmp() As String, FDM_list() As String, test(2) As String
Dim sourceRange As Range
Dim destrange As Range
Dim k As Integer, j As Integer, i As Integer


Z1 = False


    With Sheets("Feuil1").Range("F1:F1000").Select
    
    ActiveCell.Interior.ColorIndex = -4142

    'Initialisation des lignes de longlet source '
    j = 1
    i = 1
      Do While Not (IsEmpty(ActiveCell))
      
        'La variable FDM_tmp contient le nom de l'onglet présent dans la cellule active'
        'Les variables Z1 et Z2 sont temporaires'
        Z2 = ActiveCell.Value
        FDM_tmp = Split(Z2, "_")
          
        
        'Test sur le changement de FDM pour chaque ligne'
        If Z1 <> FDM_tmp(1) Then

            
            'On redimensionne le tableau et on augmente le compteur'
            'ReDim FDM_list(3)
            'FDM_list(i) = FDM_tmp(1)
            'i = i + 1
            
            'Initialisation des lignes de longlet de destination'
            k = 1
            
            'Si l'onglet nexiste pas'
            If Onglet_exist(FDM_tmp(1)) = False Then
            
                ActiveCell.Interior.ColorIndex = 3
                Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
                ActiveSheet.Name = FDM_tmp(1)
                    
            'Si longlet existe'
            Else
                
                Sheets(FDM_tmp(1)).Delete
                Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
                ActiveSheet.Name = FDM_tmp(1)
            End If

        End If
        
        'Initialisation de Z1 avec le nom de longlet'
        Z1 = FDM_tmp(1)
        
        'Processus de copie de chaque ligne'
        Set sourceRange = Sheets("Feuil1").Range("A" & j & ":L" & j)
        Set destrange = Sheets(FDM_tmp(1)).Range("A" & k & ":L" & k)
        sourceRange.Copy destrange
        destrange.Interior.ColorIndex = -4142 'aucune couleur
        
        Sheets("Feuil1").Select
    
        j = j + 1
        k = k + 1

        
        Selection.Offset(1, 0).Select
        
        Loop

        
    End With
    
   ' For w = 1 To UBound(FDM_list)
   '     MsgBox FDM_list(w)
   ' Next
   
With Sheets("FDM40013")
    .Select
    Selection.EntireRow.Insert 'insertion ligne
    .Cells(1, 1).Value = "Chorus Version"
    .Cells(1, 2).Value = "Test type"
    .Cells(1, 3).Value = "Batch"
    .Cells(1, 4).Value = "Item ID"
    .Cells(1, 5).Value = "Test ID"
    .Cells(1, 6).Value = "Test Name"
    .Cells(1, 7).Value = "Test description"
    .Cells(1, 8).Value = "Total Steps"
    .Cells(1, 9).Value = "Step#"
    .Cells(1, 10).Value = "Step description"
    .Cells(1, 11).Value = "Expected result"
    
    .Columns("B:B").ColumnWidth = 20.14
    .Columns("A:A").ColumnWidth = 8.14
    .Columns("D:D").ColumnWidth = 7.86
    .Columns("E:E").ColumnWidth = 6.14
    .Columns("C:C").ColumnWidth = 15
    .Columns("F:F").ColumnWidth = 26.14
    .Columns("G:G").ColumnWidth = 45.71
    .Columns("J:J").ColumnWidth = 12.29
    .Columns("K:K").ColumnWidth = 24
    .Columns("J:J").ColumnWidth = 23.57
    
    .Cells.Select
    With Selection
        .WrapText = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    .Range("A1:L1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Gras"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

  End With
    
    End Sub

'Fonction permettant de tester l'existence d'un onglet'
Private Function Onglet_exist(Nom As String) As Boolean
    Dim sh As Worksheet
    Onglet_exist = False
    For Each sh In Sheets
    
        If sh.Name = Nom Then
            Onglet_exist = True
            Exit For
        End If
    Next
End Function

Dès que je passe dans le : 'If Onglet_exist(FDM_tmp(1)) = False Then' je voudrais stocker FDM_tmp(1) dans un tableau qui s'agrandit a chaque fois que je trouve une nouvelle valeur FDM_tmp(1)

Jai essayé avec
'On redimensionne le tableau et on augmente le compteur'
'ReDim FDM_list(3)
'FDM_list(i) = FDM_tmp(1)
'i = i + 1


mais redim efface les valeurs existantes du tableau.

Avez vous une solution ?

Merci de votre aide,

Cdt,

Arthur Ho.
 

Pièces jointes

  • Boucle-Copy.zip
    124.8 KB · Affichages: 20
  • Boucle-Copy.zip
    124.8 KB · Affichages: 17
  • Boucle-Copy.zip
    124.8 KB · Affichages: 29

Discussions similaires

Réponses
0
Affichages
153

Statistiques des forums

Discussions
312 215
Messages
2 086 316
Membres
103 176
dernier inscrit
jean.yvesjean.yves