Redim preserve array

Bonjour,

Je cherche à utiliser la fonction redim preserve pour un tableau à deux dimensions.

Sub formulaire_manquant()
Dim tab_form() As Variant

With Sheets("Planning")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 3) = "N" Then
        ReDim Preserve tab_form(1 To n, 1 To 2)
            tab_form(n, 0) = .Cells(i, 1)
            tab_form(n, 1) = .Cells(i, 2)
            N=N+1
        End If
    Next i
    With Sheets("formulaire_manquant")
        Range("A1:B" & n) = tab_form
    End With
End With
End Sub

Si je peux avoir un petit coup de main je vous en serait reconnaissant.

Je sais que je pourrais ne pas passer par un array mais j'aimerais bien maitriser cette fonctionnalité et trouver les solutions les plus optimales.

Je vous joints un petit fichier tout se passe dans :

–> Module : Formulaire manquant, sub Formulaire_manquant

bonjour

redim preserve ne fonctionne qu'avec la dernière dimension.

solutions possibles

soit transposer les 2 dimensions (application. transpose est limité (à 32767 lignes, si mes souvenirs sont corrects))

redim preserve tab_form(1 to 2, 1 to n) et adapter l'instruction Range("A1:B" & n) = application.transpose( tab_form)

soit dimensionner le tableau au maximum possible

dl=.cells(rows.count,1).end(xlup).row
redim tab_form(1 to dl, 1 to 2)
n=1
for i=2 to dl
If .Cells(i, 3) = "N" Then
            tab_form(n, 1) = .Cells(i, 1)
            tab_form(n, 2) = .Cells(i, 2)
            N=N+1
        End If
    Next i
    With Sheets("formulaire_manquant")
        Range("A1:B" & n) = tab_form
    End With

Bonjour,

Sub Formulaire_manquant()
Dim RS As Object: Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "A", 129, 50: RS.Fields.Append "B", 129, 50 : RS.Open
With Sheets("Planning")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 3) = "N" Then
            RS.AddNew
            RS("A") = .Cells(i, 1)
            RS("B") = .Cells(i, 2)
            RS.Update
            RS.MoveFirst
       End If
    Next i

    With Sheets("Formulaires_manquants")
        .Range("A1").CurrentRegion.Clear
        .Range("A1").CopyFromRecordset RS
    End With
End With
End Sub

bonjour Dysorthographie,

J'oublie toujours cette solution pourtant très élégante ...

Merci pour vos réponses.

Ces petits bout de code m'aide vraiment à faire progresser mes connaissances. :)

Bon week end !