Copier des lignes sur une autre feuille sous conditions
Résolu
anana49
Messages postés
20
Date d'inscription
Statut
Membre
Dernière intervention
-
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je souhaiterai copier des données sur une autre feuille de mon classeur en incluant les conditions :
S'il trouve dans la colonne A de ma feuille "Source", le chiffre 7, il doit prendre toutes les lignes au dessus (de 1 à 6 inclus) et les copier sur ma feuille "Tranche" en cellule A7. Autre condition :
S'il trouve dans la colonne A de ma feuille "Source", le chiffre 6, il doit prendre toutes les lignes en dessous (de 7 à ....) et les copier sur ma feuille "Tranche" en cellule A23.
Je me mélange les pédales avec les boucles..et conditions..
Merci pour votre aide.
Je souhaiterai copier des données sur une autre feuille de mon classeur en incluant les conditions :
S'il trouve dans la colonne A de ma feuille "Source", le chiffre 7, il doit prendre toutes les lignes au dessus (de 1 à 6 inclus) et les copier sur ma feuille "Tranche" en cellule A7. Autre condition :
S'il trouve dans la colonne A de ma feuille "Source", le chiffre 6, il doit prendre toutes les lignes en dessous (de 7 à ....) et les copier sur ma feuille "Tranche" en cellule A23.
Je me mélange les pédales avec les boucles..et conditions..
Merci pour votre aide.
1 réponse
-
Bonjour,
Le chiffre 6 ou 7 n'est qu'une seule fois dans la colonne A??-
-
-
Bonjour,
une facon de voir, adaptez en fonction de vos 1 a 6 et 7 a ..... (pas bien compris!!!!!):
Sub Tranche() Dim Plage As Range With Worksheets("Source") 'recherche valeur 7 R = 7 Nb = Application.CountIf(.Columns(1), R) 'Nb fois R If Nb > 0 Then lig = .Columns(1).Find(R, .Cells(1, 1), , xlWhole).Row 'ligne de R dercol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'derniere colonne de la feuille If lig < 8 Then LD = 1 Else LD = lig - 7 'si lig<7 Set Plage = .Range(.Cells(LD, 1), .Cells(lig, dercol)) 'mise en memoire de la plage de cellules Worksheets("Tranche").Range("A7").Resize(6, dercol) = Plage.Value 'copie plage End If 'recherche valeur 6 R = 6 Nb = Application.CountIf(.Columns(1), R) If Nb > 0 Then lig = .Columns(1).Find(R, .Cells(1, 1), , xlWhole).Row derlig = .Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A LF = derlig - lig + 1 'taille plage en "longueur dercol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column Set Plage = .Range(.Cells(lig, 1), .Cells(derlig, dercol)) Worksheets("Tranche").Range("A23").Resize(LF, dercol) = Plage.Value End If End With End Sub -
Bonjour un peu tardif..
Merci pour votre code. Il fonctionne sauf qu'il me colle les lignes de 1 à 5 en A7 sur ma feuille "Tranche" au lieu des lignes de 1 à 6 pour la 1ère condition et pour la deuxième condition, il me colle les lignes de 6 à ++ sur la feuille "Tranche" en A23 au lieu des lignes de 7 à ++.
J'ai essayé de modifier en fonction mais je ne comprends pas le code ???
J'ai fait un autre code mais j'aurais préféré adapter le votre. Pour votre compréhension, je vous joins mon code :Sub CopierTranches() Dim xlWsh1 As Object, xlWsh2 As Object Dim L As Long Dim lgDerlig1 As Long Dim lgDerLig2 As Long 'feuilles du traitement Set xlWsh1 = Worksheets("Source") Set xlWsh2 = Worksheets("Tranche") 'récupération du dernier enregistrement de chaque feuille lgDerlig1 = xlWsh1.UsedRange.Rows.Count lgDerLig2 = xlWsh2.UsedRange.Rows.Count With xlWsh1 'lecture du classeur source à parir de la ligne 1 For L = 1 To lgDerlig1 ' fin du traitement si valeur est trouvé en cellule A If .Cells(L, 1).Value = "7" Then Exit For Else 'copie des lignes de la feuille 1 si cellule A n'est pas vide If .Cells(L, 1).Value <> "" Then .Rows(L).Copy Destination:=xlWsh2.Range("A7").Rows(lgDerLig2) lgDerLig2 = lgDerLig2 + 1 End If End If Next L For L = 8 To lgDerlig1 ' fin du traitement si valeur est trouvé en cellule A If .Cells(L, 1).Value = "6" Then Exit For Else 'copie des lignes de la feuille 1 si cellule A n'est pas vide If .Cells(L, 1).Value <> "" Then .Rows(L).Copy Destination:=xlWsh2.Range("A16").Rows(lgDerLig2) lgDerLig2 = lgDerLig2 + 1 End If End If Next L End With End Sub -
-
