Copier une plage de cellule a condition que .
eric.330
Messages postés
70
Statut
Membre
-
eric.330 Messages postés 70 Statut Membre -
eric.330 Messages postés 70 Statut Membre -
Bonjour le forum,
J'ai un tableau qui va de la colonne B à la colonne AF et de la ligne 4 à la ligne 33. Ces cellules sont remplies de formules, toutes les lignes peuvent ne pas etre remplies ... Je souhaiterais copier la plage de cellule ( B4:AF4) si la valeur de AG4>=1 ( en sachant que si la AG=1 ou plus, la ligne est remplie sinon ="").Et Ainsi de suite pour chaque ligne ... Et ensuite recopier les selection dans une autre feuille cellule B2 (nommée dest)"Dates"
Voici le code que j'ai rentré mais qui ne fonctionne que pour la premiere ligne ...
Sub PasàPas33()
Application.ScreenUpdating = False
Dim Résumé As Worksheets ' déclare Résumé comme feuille
Dim Dates As Worksheets ' déclare Dates comme feuille
Dim Données1 As Range ' déclare Données1 comme variable
Set Données1 = Worksheets("Résumé").Range("B4:AF33") ' Définie la plage Données1
Dim I As Range ' déclare cel comme variable
Set I = Worksheets("Résumé").Range("controle") ' Définie la plage I
Dim dest As Range ' déclare dest comme variable
Set dest = Worksheets("Dates").Range("B2") ' Définie la plage dest
Dim ligne As Range
Sheets("Résumé").Select ' Sélectionne feuille Résumé
If Cells(4, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B4:AF4").Select ' Sélectionne plage B4:AF4
Else
If Cells(5, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B5:AF5").Select ' Sélectionne plage B4:AF4
Else
If Cells(6, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B6:AF6").Select ' Sélectionne plage B4:AF4
Else
If Cells(7, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B7:AF7").Select ' Sélectionne plage B4:AF4
Else
If Cells(8, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B8:AF8").Select ' Sélectionne plage B4:AF4
Else
If Cells(9, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B9:AF9").Select ' Sélectionne plage B4:AF4
Else
If Cells(10, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B10:AF10").Select ' Sélectionne plage B4:AF4
Else
If Cells(11, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B11:AF11").Select ' Sélectionne plage B4:AF4
Else
If Cells(12, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B12:AF12").Select ' Sélectionne plage B4:AF4
Else
If Cells(13, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B13:AF13").Select ' Sélectionne plage B4:AF4
Else
If Cells(14, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B14:AF14").Select ' Sélectionne plage B4:AF4
Else
If Cells(15, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B15:AF15").Select ' Sélectionne plage B4:AF4
Else
If Cells(16, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B16:AF16").Select ' Sélectionne plage B4:AF4
Else
If Cells(17, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B17:AF17").Select ' Sélectionne plage B4:AF4
Else
If Cells(18, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B18:AF418").Select ' Sélectionne plage B4:AF4
Else
If Cells(19, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B19:AF19").Select ' Sélectionne plage B4:AF4
Else
If Cells(20, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B20:AF20").Select ' Sélectionne plage B4:AF4
Else
If Cells(21, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B21:AF21").Select ' Sélectionne plage B4:AF4
Else
If Cells(22, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B22:AF22").Select ' Sélectionne plage B4:AF4
Else
If Cells(23, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B23:AF23").Select ' Sélectionne plage B4:AF4
Else
If Cells(24, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B24:AF24").Select ' Sélectionne plage B4:AF4
Else
If Cells(25, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B25:AF25").Select ' Sélectionne plage B4:AF4
Else
If Cells(26, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B26:AF26").Select ' Sélectionne plage B4:AF4
Else
If Cells(27, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B27:AF27").Select ' Sélectionne plage B4:AF4
Else
If Cells(28, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B28:AF28").Select ' Sélectionne plage B4:AF4
Else
If Cells(29, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B29:AF29").Select ' Sélectionne plage B4:AF4
Else
If Cells(30, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B30:AF30").Select ' Sélectionne plage B4:AF4
Else
If Cells(31, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B31:AF31").Select ' Sélectionne plage B4:AF4
Else
If Cells(32, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B32:AF32").Select ' Sélectionne plage B4:AF4
Else
If Cells(33, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B33:AF33").Select ' Sélectionne plage B4:AF4
'Else
' Selection.Copy ' Copie la sélection
' Sheets("Dates").Select ' Sélectionne feuille Dates
'Range("dest").Select ' Sélectionne cellule dest
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False ' Colle la sélection en collage spécial que sa valeur
'tu peux aussi écrire
'If Application.WorksheetFunction.And(a = b, e = f, f = g) Then
'...
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Les anotations ne sont pas forcement bonnes car je n'arrete pas de bidouiller ...
Par avance merci de votre precieuse aide qui me fera avancer ....
Eric
J'ai un tableau qui va de la colonne B à la colonne AF et de la ligne 4 à la ligne 33. Ces cellules sont remplies de formules, toutes les lignes peuvent ne pas etre remplies ... Je souhaiterais copier la plage de cellule ( B4:AF4) si la valeur de AG4>=1 ( en sachant que si la AG=1 ou plus, la ligne est remplie sinon ="").Et Ainsi de suite pour chaque ligne ... Et ensuite recopier les selection dans une autre feuille cellule B2 (nommée dest)"Dates"
Voici le code que j'ai rentré mais qui ne fonctionne que pour la premiere ligne ...
Sub PasàPas33()
Application.ScreenUpdating = False
Dim Résumé As Worksheets ' déclare Résumé comme feuille
Dim Dates As Worksheets ' déclare Dates comme feuille
Dim Données1 As Range ' déclare Données1 comme variable
Set Données1 = Worksheets("Résumé").Range("B4:AF33") ' Définie la plage Données1
Dim I As Range ' déclare cel comme variable
Set I = Worksheets("Résumé").Range("controle") ' Définie la plage I
Dim dest As Range ' déclare dest comme variable
Set dest = Worksheets("Dates").Range("B2") ' Définie la plage dest
Dim ligne As Range
Sheets("Résumé").Select ' Sélectionne feuille Résumé
If Cells(4, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B4:AF4").Select ' Sélectionne plage B4:AF4
Else
If Cells(5, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B5:AF5").Select ' Sélectionne plage B4:AF4
Else
If Cells(6, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B6:AF6").Select ' Sélectionne plage B4:AF4
Else
If Cells(7, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B7:AF7").Select ' Sélectionne plage B4:AF4
Else
If Cells(8, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B8:AF8").Select ' Sélectionne plage B4:AF4
Else
If Cells(9, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B9:AF9").Select ' Sélectionne plage B4:AF4
Else
If Cells(10, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B10:AF10").Select ' Sélectionne plage B4:AF4
Else
If Cells(11, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B11:AF11").Select ' Sélectionne plage B4:AF4
Else
If Cells(12, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B12:AF12").Select ' Sélectionne plage B4:AF4
Else
If Cells(13, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B13:AF13").Select ' Sélectionne plage B4:AF4
Else
If Cells(14, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B14:AF14").Select ' Sélectionne plage B4:AF4
Else
If Cells(15, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B15:AF15").Select ' Sélectionne plage B4:AF4
Else
If Cells(16, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B16:AF16").Select ' Sélectionne plage B4:AF4
Else
If Cells(17, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B17:AF17").Select ' Sélectionne plage B4:AF4
Else
If Cells(18, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B18:AF418").Select ' Sélectionne plage B4:AF4
Else
If Cells(19, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B19:AF19").Select ' Sélectionne plage B4:AF4
Else
If Cells(20, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B20:AF20").Select ' Sélectionne plage B4:AF4
Else
If Cells(21, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B21:AF21").Select ' Sélectionne plage B4:AF4
Else
If Cells(22, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B22:AF22").Select ' Sélectionne plage B4:AF4
Else
If Cells(23, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B23:AF23").Select ' Sélectionne plage B4:AF4
Else
If Cells(24, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B24:AF24").Select ' Sélectionne plage B4:AF4
Else
If Cells(25, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B25:AF25").Select ' Sélectionne plage B4:AF4
Else
If Cells(26, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B26:AF26").Select ' Sélectionne plage B4:AF4
Else
If Cells(27, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B27:AF27").Select ' Sélectionne plage B4:AF4
Else
If Cells(28, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B28:AF28").Select ' Sélectionne plage B4:AF4
Else
If Cells(29, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B29:AF29").Select ' Sélectionne plage B4:AF4
Else
If Cells(30, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B30:AF30").Select ' Sélectionne plage B4:AF4
Else
If Cells(31, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B31:AF31").Select ' Sélectionne plage B4:AF4
Else
If Cells(32, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B32:AF32").Select ' Sélectionne plage B4:AF4
Else
If Cells(33, 33).Value >= 1 Then ' Si la cellule Y4 est supérieure ou égale à 1
' Alors
Range("B33:AF33").Select ' Sélectionne plage B4:AF4
'Else
' Selection.Copy ' Copie la sélection
' Sheets("Dates").Select ' Sélectionne feuille Dates
'Range("dest").Select ' Sélectionne cellule dest
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False ' Colle la sélection en collage spécial que sa valeur
'tu peux aussi écrire
'If Application.WorksheetFunction.And(a = b, e = f, f = g) Then
'...
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Les anotations ne sont pas forcement bonnes car je n'arrete pas de bidouiller ...
Par avance merci de votre precieuse aide qui me fera avancer ....
Eric
A voir également:
- Copier une plage de cellule a condition que .
- Excel cellule couleur si condition texte - Guide
- Comment copier une vidéo youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Aller à la ligne dans une cellule excel - Guide
- Frédéric cherche à faire le buzz sur les réseaux sociaux. il a ajouté une image d’ours polaire sur une image de plage. retrouvez l'image originale de la plage. que cache l'ours polaire ? ✓ - Forum Google Chrome
2 réponses
Bonsoir,
Tel que écrit, un seul test peut être positif.
Tu aurais du tester toutes les lignes :
if ... then
...
endif
if ... then
...
endif
etc
Mais pas trop efficace, essaie plutôt ce code qui balaie les lignes dans une boucle :
eric
Tel que écrit, un seul test peut être positif.
Tu aurais du tester toutes les lignes :
if ... then
...
endif
if ... then
...
endif
etc
Mais pas trop efficace, essaie plutôt ce code qui balaie les lignes dans une boucle :
Sub copier()
Dim shSource As Worksheet, shDest As Worksheet, lig As Long
Set shSource = Worksheets("Résumé")
Set shDest = Worksheets("Dates")
' nettoyer destination
shDest.Rows("2:65536").ClearContents
' copier lignes
For lig = 4 To 33
If shSource.Cells(lig, "AG") >= 1 Then
shSource.Range("B" & lig & ":AF" & lig).Copy Destination:=shDest.Cells(shDest.[A65536].End(xlUp).Row + 1, 1)
End If
Next lig
End Sub
eric
Ah oui, excuse moi :
Testé cette fois ;-)
eric
Sub copier()
Dim shSource As Worksheet, shDest As Worksheet, lig As Long
Set shSource = Worksheets("Résumé")
Set shDest = Worksheets("Dates")
Application.ScreenUpdating = False
' nettoyer destination
shDest.Rows("2:65536").ClearContents
' copier lignes
For lig = 4 To 33
If shSource.Cells(lig, "AG") >= 1 Then
shSource.Range("B" & lig & ":AF" & lig).Copy
shDest.Cells(shDest.[B65536].End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlPasteValues
End If
Next lig
Application.ScreenUpdating = True
End Sub
sera mieux.
Testé cette fois ;-)
eric
Re , ça fonctionne bien oui, merci :-)
C'est vraiment tres sympa de ta part. Efficace, rapide et concis .... ;-)
Si je voudrais que les cellules se recopient en partant d'en haut, qu'elle modification a apporter ? ,
Et, je voudrais entrer une formule si (A1="";"";1) mais toutes les cellules ont une formule donc ça me renvoie toujours 1. Comment faut il que je procède pour y arriver ?
Meric Eric
C'est vraiment tres sympa de ta part. Efficace, rapide et concis .... ;-)
Si je voudrais que les cellules se recopient en partant d'en haut, qu'elle modification a apporter ? ,
Et, je voudrais entrer une formule si (A1="";"";1) mais toutes les cellules ont une formule donc ça me renvoie toujours 1. Comment faut il que je procède pour y arriver ?
Meric Eric
Soyons précis.
Tu le passes 2 fois
et tu as les lignes 2, 4, 5 à copier une première fois. Puis 3, 5, 6 la 2nde fois (les valeurs ayant changé entretemps).
Tu veux quoi en résultat ?
3, 5, 6, 2 ,4 ,5 soit 2 blocs, le 2nd en haut, les lignes dans l'ordre?
ou
5 4 2 6 5 3 ?
ou
6 5 3 5 4 2 ?
autre chose ?
eric
Tu le passes 2 fois
et tu as les lignes 2, 4, 5 à copier une première fois. Puis 3, 5, 6 la 2nde fois (les valeurs ayant changé entretemps).
Tu veux quoi en résultat ?
3, 5, 6, 2 ,4 ,5 soit 2 blocs, le 2nd en haut, les lignes dans l'ordre?
ou
5 4 2 6 5 3 ?
ou
6 5 3 5 4 2 ?
autre chose ?
eric
ça reste aléatoire, la sélection des lignes se fait en fonction du 1 ou pas dans la collanne AG. Ce que je souhaiterais, c'est que ça recopie les lignes comme ça le fait dans ta macro et que ça les recopie en partant de B2 de la feuille de destination et vers le bas ( en sachant que les lignes deja enregistées ne sont pas effacées. Donc pour etre precis, ça copie les nouvelles lignes en B2 et décalle les anciennes vers l e bas tout simplement ...
Et concernant la question sur la la formule, pour etre precis la aussi, comment fait on pour différencier une cellule vide d'une cellule qui contient une formule dont le resultat de cette formule est =0 ?
Et concernant la question sur la la formule, pour etre precis la aussi, comment fait on pour différencier une cellule vide d'une cellule qui contient une formule dont le resultat de cette formule est =0 ?
Les cellules collent bien sur en ag >= a 1 ==== Nickel
Cependant,
1 je souhaiterais coller que la valeiur des cellules et non la formule,
2 Le collage en feuille de destination se fait en A alors que je voudrais qu'il se fasse en B2
Par avance merci de ta reponse
Eric
Sub copier()
Dim shSource As Worksheet, shDest As Worksheet, lig As Long
Set shSource = Worksheets("Résumé")
Set shDest = Worksheets("Dates")
' nettoyer destination
shDest.Rows("2:65536").ClearContents
' copier lignes
For lig = 4 To 33
If shSource.Cells(lig, "AG") >= 1 Then
shSource.Range("B" & lig & ":AF" & lig).value.Copy Destination:=shDest.Cells(shDest.[B65536].End(xlUp).Row + 1, 2)
End If
Next lig
End Sub
essaie cette modif faite en direct (non testée)
eric
Voici l'erreur que ça m'annonce : Erruer 424 Objer Requis
Et la ligne suivante est en jaune :
shSource.Range("B" & lig & ":AF" & lig).Value.Copy Destination:=shDest.Cells(shDest.[B65536].End(xlUp).Row + 1, 2)
Eric