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.
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
Bonjour,
Oui c'est quand il trouve le chiffre 7 en colonne A, il doit me coller les valeurs de toute cette ligne ainsi que les suivantes sur la feuille "Tranche" en A23.
Non on s'est mal compris c'est quand il trouve le chiffre 6 en colonne A, il doit coller les lignes du dessous à partir de la ligne ou la valeur trouvée est 7..
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.
Vous devriez vous relire:
Non on s'est mal compris c'est quand il trouve le chiffre 6 en colonne A, il doit coller les lignes du dessous à partir de la ligne ou la valeur trouvée est 7..
Ce n'est pas grave, j'ai du mal à m'expliquer.. La première tranche doit être copiée de la ligne 1 à la ligne 6 en A7 et la deuxième tranche de la ligne 7 à ++ (Jusqu'à la dernière ligne où il y a des valeurs) en A23 sur ma feuille "Tranche".
Ceci est un dernier essai de compréhension sinon tant pis pour moi.. Dommage votre code était mieux que le mien !! Merci quand même.
Enfin de compte dans la colonne A, des numeros de 1 a x et toujours les memes ??
Code modifie, sauf subtilite encore ignoree
Sub Tranche()
Dim Plage As Range
With Worksheets("Source")
'recherche valeur 6
R = 6
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 < 7 Then LD = 2 Else LD = lig - 6 '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 7
R = 7
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 '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
Merci pour cette modification mais à l'exécution du code, il manque sur la première tranche la ligne où on trouve le "6" et sur la deuxième tranche la dernière ligne où on trouve le "9".
Ci dessous le résultat du code :
Sub Tranche()
Dim Plage As Range
With Worksheets("Source")
'recherche valeur 6
R = 6
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 < 7 Then LD = 2 Else LD = lig - 6 '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(7, dercol) = Plage.Value 'copie plage
End If
'recherche valeur 7
R = 7
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
Merci beaucoup et je comprends le code maintenant avec tes modifications.. Il était temps !!
Je te souhaite de bonne fêtes de fin d'année.
A très bientôt, ton aide a été très précieuse !
- Messages postés
- 14066
- Date d'inscription
- dimanche 25 novembre 2007
- Dernière intervention
- 17 février 2019
1301 -Enfin de compte dans la colonne A, des numeros de 1 a x et toujours les memes ??
Code modifie, sauf subtilite encore ignoree
Sub Tranche() Dim Plage As Range With Worksheets("Source") 'recherche valeur 6 R = 6 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 < 7 Then LD = 2 Else LD = lig - 6 '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 7 R = 7 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 '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- Messages postés
- 20
- Date d'inscription
- jeudi 12 juillet 2018
- Dernière intervention
- 20 décembre 2018
-Ci dessous le résultat du code :
Ci-dessous ce que je souhaite obtenir :
- Messages postés
- 14066
- Date d'inscription
- dimanche 25 novembre 2007
- Dernière intervention
- 17 février 2019
1301 -Ok, pourtant simple a modifier!!
Sub Tranche() Dim Plage As Range With Worksheets("Source") 'recherche valeur 6 R = 6 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 < 7 Then LD = 2 Else LD = lig - 6 '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(7, dercol) = Plage.Value 'copie plage End If 'recherche valeur 7 R = 7 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- Messages postés
- 20
- Date d'inscription
- jeudi 12 juillet 2018
- Dernière intervention
- 20 décembre 2018
-Je te souhaite de bonne fêtes de fin d'année.
A très bientôt, ton aide a été très précieuse !
- Messages postés
- 14066
- Date d'inscription
- dimanche 25 novembre 2007
- Dernière intervention
- 17 février 2019
1301 -Bonnes fetes
Bye….