Copie partie de ligne selon valeur de cellule

Question

Je bute alors que je sais la réponse simple. Je voudrais que la macro copie les cellules C, D M, P, R et S de chaque ligne vers la feuille "argent de poche semi autonomie" si la cellule O contient "semi_autonomie" ou "diffus" la feuille "Argent de poche collectif" sir la cellule 0 contient "collectif" J'ai commencé mais je n'arrive pas à sélectionner les cellules et non toutes la lignes : Worksheets("Argent de poche_collectif").Range("A2:H200").Clear ' Récupérer la dernière ligne du tableau With Sheets("effectif") For i = 1 To 881 'pour les lignes de 1 à 881 If .Range("O" & i).Value = "Collectif" Then Set plage = .Range("C" & i & ", AG" & i & ":AK" & i) 'initialisation de cette plage End If Next i Range("A2:A" & DLig & ",B2:B" & DLig & ",D2:D" & DLig & ",M2:M" & DLig & ",R2:R" & DLig & ",S2:S" & DLig & ",AF2:AF" & DLig).Copy 'Ouvre le fichier ou l'on colle les données With Sheets("Argent de poche").Range("A4").End(xlUp)(2) .PasteSpecial Paste:=xlPasteValues, Transpose:=False End With Je vous joints mon fichier...

ThauThème · Answer

Bonsoir Theyoshi, bonsoir le forum,

En pièce jointe ton fichier modifié affecte la macro Macro1 du module Module1 à un bouton ou lance la...

Le code :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD1 As Worksheet 'déclare la variable OS (Onglet Destination 1)
Dim OD2 As Worksheet 'déclare la variable OS (Onglet Destination 2)
Dim TSA As ListObject 'déclare la variable TSA (tableau structuré TSA)
Dim TC As ListObject 'déclare la variable TC (tableau structuré TC)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL1() As Variant 'déclare la variable TL1 (Tableau des Lignes 1)
Dim TL2() As Variant 'déclare la variable TL2 (Tableau des Lignes 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K1 As Integer 'déclare la variable K1 (incrément)
Dim K2 As Integer 'déclare la variable K2 (incrément)

Set OS = Worksheets("Effectif") 'définit l'onglet OS
Set OD1 = Worksheets("Argent de poche semi autonomie") 'définit l'onglet OD1
Set OD2 = Worksheets("Argent de poche collectif") 'définit l'onglet OD2
TV = OS.Range("effectif") 'définit le tableau des valeurs TV
Set TSA = OD1.ListObjects("TSA") 'définit le tableau structuré TSA
Set TC = OD2.ListObjects("TC") 'définit le tableau structuré TC
OD1.Range("A1").CurrentRegion.Offset(2, 0).ClearContents 'efface les anciennes données de l'onglet OD1
TSA.Resize OD1.Range("A2:H3") 'redimensionne le tableau structuré TSA
OD2.Range("A1").CurrentRegion.Offset(2, 0).ClearContents 'efface les anciennes données de l'onglet OD2
TC.Resize OD2.Range("A2:H3") 'redimensionne le tableau structuré TC
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau eds valeurs TV
    If TV(I, 15) = "Semi_autonomie" Or TV(I, 15) = "Diffus" Then 'condition 1 : si la donnée ligne I colonne 15 de TV est égale à "Semi_autonomie" ou "Diffus"
        K1 = K1 + 1 'incrémente K1
        ReDim Preserve TL1(1 To 6, 1 To K1) 'redimensionne le tableau des lignes TL1 (6 lignes, K1 colonnes)
        TL1(1, K1) = TV(I, 3) 'récupère dans la ligne 1 de TL1 la donné  en colonne 3 de TV (=> Transposition)
        TL1(2, K1) = TV(I, 4) 'récupère dans la ligne 2 de TL1 la donné  en colonne 4 de TV (=> Transposition)
        TL1(3, K1) = TV(I, 13) 'récupère dans la ligne 3 de TL1 la donné  en colonne 13 de TV (=> Transposition)
        TL1(4, K1) = TV(I, 16) 'récupère dans la ligne 4 de TL1 la donné  en colonne 13 de TV (=> Transposition)
        TL1(5, K1) = TV(I, 18) 'récupère dans la ligne 5 de TL1 la donné  en colonne 18 de TV (=> Transposition)
        TL1(6, K1) = TV(I, 19) 'récupère dans la ligne 6 de TL1 la donné  en colonne 19 de TV (=> Transposition)
    End If 'fin de la condition 1
    If TV(I, 15) = "Collectif" Then 'condition 2 : si la donnée ligne I colonne 15 de TV est égale à "Collectif"
        K2 = K2 + 1 'incrémente K2
        ReDim Preserve TL2(1 To 6, 1 To K2) 'redimensionne le tableau des lignes TL2 (6 lignes, K2 colonnes)
        TL2(1, K2) = TV(I, 3) 'récupère dans la ligne 1 de TL2 la donné  en colonne 3 de TV (=> Transposition)
        TL2(2, K2) = TV(I, 4) 'récupère dans la ligne 2 de TL2 la donné  en colonne 4 de TV (=> Transposition)
        TL2(3, K2) = TV(I, 13) 'récupère dans la ligne 3 de TL2 la donné  en colonne 13 de TV (=> Transposition)
        TL2(4, K2) = TV(I, 16) 'récupère dans la ligne 4 de TL2 la donné  en colonne 13 de TV (=> Transposition)
        TL2(5, K2) = TV(I, 18) 'récupère dans la ligne 5 de TL2 la donné  en colonne 18 de TV (=> Transposition)
        TL2(6, K2) = TV(I, 19) 'récupère dans la ligne 6 de TL2 la donné  en colonne 19 de TV (=> Transposition)
    End If 'fin de la condition 2
Next I 'prochaine ligne de la boucle
'si K1 est supérieure à zéro renvoie le tableau TL1 transposé dans la première cellule (redimensionnée) du tableau structuré TSA
If K1 > 0 Then Range("TSA").Item(1, 1).Resize(K1, 6).Value = Application.Transpose(TL1)
'si K2 est supérieure à zéro renvoie le tableau TL2 transposé dans la première cellule (redimensionnée) du tableau structuré TSA
If K2 > 0 Then Range("TC").Item(1, 1).Resize(K2, 6).Value = Application.Transpose(TL2)
End Sub

Le fichier :

18theyoshi-ep-v01.xlsm (123.50 Ko)