Copier coller une plage si condition
Bonjour
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
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).
Bonjour
et merci pour ton temps accordé ! cela fonctionne parfaitement :)
J'essayai avec Resize pour la dimension de mon tableau sans succès
Encore merci