Aide sur une formule VBA

Bonjour

Voici le code que je voudrais modifier.

Sub RECAP()

Rows("7:7").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

Dim i As Long, j As Long

Worksheets("Récapitulatif").Select

Range("A2").Select

For i = 7 To Worksheets.Count

j = i

With Worksheets(i)

Cells(j, 1).Value = .Range("a21").Value

Cells(j, 2).Value = .Range("e3").Value

Cells(j, 3).Value = .Range("e5").Value

Cells(j, 4).Value = .Range("e9").Value

Cells(j, 5).Value = .Range("b21").Value

Cells(j, 6).Value = .Range("e21").Value

Cells(j, 7).Value = .Range("d21").Value

Cells(j, 8).Value = .Range("i21").Value

Cells(j, 9).Value = .Range("j21").Value

End With

Next

For i = 7 To Worksheets.Count

j = i + 1

With Worksheets(i)

Cells(j, 1).Value = .Range("a22").Value

Cells(j, 2).Value = .Range("e3").Value

Cells(j, 3).Value = .Range("e5").Value

Cells(j, 4).Value = .Range("e9").Value

Cells(j, 5).Value = .Range("b22").Value

Cells(j, 6).Value = .Range("e22").Value

Cells(j, 7).Value = .Range("d22").Value

Cells(j, 8).Value = .Range("i22").Value

Cells(j, 9).Value = .Range("j22").Value

End With

Next

End Sub

Je m'explique j'aimerais ne pas à avoir à écrire à chaque fois la procédure que celle-ci se fasse automatiquement jusqu'à la dernière ligne où se trouve du texte.

Quelqu'un aurait-il la solution. Merci

Bonjour,

une possibilité avec un Array,

addr = Array("A21", "E3", "E5", "E9", "B21", "E21", "D21", "I21", "J21")

For y = 1 To 9
Cells(j, y).Value = .Range(addr(y - 1)).Value
End With

Merci

Par contre j'aimerais que les cellules e3 e5 et e9 ne change pas. Est ce possible ?

Je pense avoir la réponse en fait. Ms au cas où je veux bien le code ^^

j'ai un soucis la formule ne marche pas. je crois qu'il ne reconnait pas array.

Bonjour,

J'aimerais voir la disposition de vos données, pouvez-vous joindre un fichier excel ?

Voici le document. Le bouton est sur la feuille nommée "récapitulatif" il s'agit d'actualisation des données. Et j'aimerais que la formule marche pour toutes les lignes de chaque personne. Voilà merci

Bonjour,

à tester,

Sub RECAP()
Dim i As Long, j As Long, k As Long, a, b, x
Dim addr1, addr2, LastRow1 As Long, LastRow2 As Long, ligne, ws As Worksheet
addr1 = Array("A", "B", "D", "E", "I", "J", "E3", "E5", "E9")
addr2 = Array(1, 5, 7, 6, 8, 9, 2, 3, 4)
With Worksheets("Récapitulatif")
 LastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
 .Rows("7:" & LastRow1).ClearContents

    For i = 7 To Worksheets.Count
      x = Sheets(i).Name
        LastRow2 = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row

         For ligne = 21 To LastRow2
           LastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

           For j = 0 To 5
            .Cells(LastRow1, addr2(j)).Value = Sheets(i).Cells(ligne, addr1(j)).Value
           Next j

           For k = 6 To 8
            .Cells(LastRow1, addr2(k)).Value = Sheets(i).Range(addr1(k)).Value
           Next k

         Next ligne
    Next i
End With
End Sub

Super merci beaucoup. Par contre je comprends pas pourquoi certaines feuilles du classeur ne sont pas prise en compte.

je comprends pas pourquoi certaines feuilles du classeur ne sont pas prise en compte.

lesquel ?

@+

Autant pour moi c'est une erreur de ma part.

Merci encore