Copier coller une plage si condition

Question

Je débute en VBA et après plusieurs recherches et test je viens vers vous pour m'aider sur mon problème Je souhaite copier seulement une partie d'une ligne vers une autre feuille si j'ai une condition. Les lignes de la colonne A à L, de la feuille "carto" (base de donnée ) doivent se copier dans ma feuille "test" si j'ai 'P' dans la colonne A (feuille "carto") Mon problème est qu'actuellement toute la ligne est copier mais cela écrase des données, au delà de la colonne L de ma feuille "test". Ma condition "P" ne sera pas sur toutes les lignes voici le code que j'ai trouvé et un peu modifié Sub test() Dim cel As Range 'déclaration d'une variable pour la boucle de type range Dim source As Range 'déclaration d'une variable qui servira de source pour la copie de donnée Worksheets("test").Range("a:s").Clear 'On vide complètement les colonne A à S la feuille de destination Set source = Sheets("Carto").Range("A11:I11").EntireRow 'Initialisation de source avec l'entête pour garder de la feuille source With Sheets("Carto") '"With" permet d'économiser un peu d'écriture, toute les commande commancant par "." se référeront automatiquement à Sheets("Carto") à l'intérieur du with For Each cel In .Range("A3:a" & .Range("A" & .Rows.Count).End(xlUp).Row) 'on boucle sur toutes les cellules de a3 à la dernière cellule occupée de la colonne a If cel.Value = "P" Then 'si le contenu de cel contient P Set source = Union(source, cel.EntireRow) 'alors on rajoute les lignes à la source End If 'fin de si Next 'prochain élément de la boucle for each (y a rien à comprendre c'est la synthaxe d'une boucle for ... next) End With ' fin du with source.Copy Worksheets("test").Range("A10") 'et hop on copie d'un coup toutes les cellule qu'on n'a mis dans source à partie de la ligne A10 Worksheets("Carto").Activate 'On active la feuille Carto (optionnel) Worksheets("Carto").Range("A10").Select 'Et on sélectionne la case A10 (la aussi optionnel) Worksheets("test").Activate Worksheets("test").Range("A1").Select End Sub Voici ce que j'ai essayé ce qui ma sembler pertinent set cel=range("A:L") mais pas de résultat Après recherche et test je pense avoir compris la boucles et les IF then ^^ Mais après beaucoup de recherche je ne comprend pas encore le Entirow, est ce la source de mon problème ? ci joint mon fichier merci pour l'aide...

ThauThème · Accepted Answer

Bonjour Flexel, bonjour le forum,

Le code ci-dessous récupère uniquement les valeurs pas les formats. Mais d'après ce que j'ai vu, ça devrait convenir :

Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Carto") 'définit l'onglet source OS
Set OD = Worksheets("test") 'définit l'onglet destination OD
OD.Range("A:S").ClearContents 'efface les anciennes valeurs colonne A à S de l'onglet destination
TV = OS.Range("A11").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If UCase(TV(I, 1)) = "P" Then 'condition : si la donnée ligne I colonne 1 de TV (convertie en majuscule) est égale à P
        K = K + 1 'incrémente K
        ReDim Preserve TL(1 To 12, 1 To K) 'redimensionne le tableau des lignes (12 lignes, K colonnes)
        For L = 1 To 12 'boucle 2 : sur 12 colonnes
            TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> Transpostion)
        Next L 'prochaine colonne de la boucle 2
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1, renvoie le tableau TL transposé dans la cellule A11 redimensionnée de l'onglet OD
If K > 1 Then OD.Range("A11").Resize(K, 12).Value = Application.Transpose(TL)
End Sub

Attention ton code original ce trouve dans le composant ThisWorkbook ! Il n'a rien à faire là (même si ne l'empêche pas de fonctionner) il doit se trouver dans un module standard (Module1 par exemple).