Copie de céllule suivant un critere

Question

Bonjour,
Je continue dans mes débuts (et ma bataille!) avec Visual Basic. Cette fois-ci j'aimerais prendre les céllules d'un tableau et les copié dans une autre feuille. Mon tableau va de AF à AH, mon critere de sélection est dans AH. Si cette valeur est superieur a 20 je veut copié les 3céllules du tableau et les collé dans une feuille en A1. J'aimerais que les céllules copier ce mettent à la suite d'où le compteur. Cependant mon chose de semblant de programme en veut rien copier du tout et sa m'énerve!! Et puis y'a le compris entre 10 et 20, j'arrive pas a trouvé la syntaxe mais bon...

Sub Trie()
   Dim don As Long
   Dim ligne As Long
   Dim compteurligne1 As Long
   Dim compteurligne2 As Long
   compteurligne1 = 1
   compteurligne2 = 1
   For i = 3 To 244
      Worksheets(17).Range("AF" & i & ":AH" & i).Copy
      If Cells(i, 34) >= 20 Then
         Worksheets(18).Range("A" & compteurligne1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurFeuille4 = compteurFeuille4 + 1
      End If
      If Cells(i,34) = (COMPRIS ENTRE 10 et 20) Then
         Worksheets(18).Range("E" & compteurligne2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurligne2 = compteurligne2 + 1
      End If
   Next i
End Sub

PS : C'est des lignes de code que j'ai récupéré sur le forum et que je tente d'adapté.

cs_MPi · Answer

Tu écris
If Cells(i, 34) >= 20 Then
         Worksheets(18).Range("A" & compteurligne1).PasteSpecial
CompteurLigne1 = 1, donc la copie se fera toujours en A1

If Cells(i,34) = (COMPRIS ENTRE 10 et 20) Then
équivaut à dire
If Cells(i,34) >= 10 AND Cells(i,34) <= 20 then

MPi

Manuj35 · Answer

Ok merci pour le "Compris entre".
Par contre la il me signale aucune érreur mais il ne me copie rien, le programme ce lance et rien ne ce passe. Il devrais copier mes céllules!! Non?

Sub Trie()
   
   Dim compteurligne1 As Long
   Dim compteurligne2 As Long
   compteurligne1 = 1
   compteurligne2 = 1
   For i = 3 To 244
      Worksheets(17).Range("AF" & i & ":AH" & i).Copy
      If Cells(i, 34) >= 20 Then
         ActiveSheets = "Reporting"
         Range("A" & compteurligne1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurligne1 = compteurligne1 + 1
      End If
      If Cells(i, 34) >= 10 And Cells(i, 34) <= 20 Then
         ActiveSheets = "Reporting"
         Range("E" & compteurligne2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurligne2 = compteurligne2 + 1
      End If
   Next i
End Sub

cs_MPi · Answer

Je ne sais pas ce qu'est la feuille 17, donc à toi de voir...
Tu pourrais insérer un MsgBox pour connaître la valeur de la cellule et de la ligne
   For i = 3 To 244
      Worksheets(17).Range("AF" & i & ":AH" & i).Copy
      If Cells(i, 34) >= 20 Then
MsgBox "La valeur de la cellule AF à cette ligne est: " & Range("AF" & i) & vbcrlf & _
    "et on se trouve à la ligne " & i

Peut-être que tu copies simplement une ligne vide et que tout fonctionne quand même correctement...

MPi

Manuj35 · Answer

Voila j'ai modifié pour plus qu'il y est de doute sur mes Worksheet mon tableau ce trouve dans Courbes. Et je veut copier tout sa dans une feuille Reporting qui est vierge.

Sub Trie()
   
   Dim compteurligne1 As Long
   Dim compteurligne2 As Long
   compteurligne1 = 1
   compteurligne2 = 1
   For i = 3 To 244
      ActiveSheets = "Courbes"
      Range("AF" & i & ":AH" & i).Copy
      If Cells(i, 34) >= 20 Then
         ActiveSheets = "Reporting"
         Range("A" & compteurligne1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurligne1 = compteurligne1 + 1
      End If
      If Cells(i, 34) >= 10 And Cells(i, 34) <= 20 Then
         ActiveSheets = "Reporting"
         Range("E" & compteurligne2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
         compteurligne2 = compteurligne2 + 1
      End If
   Next i
End Sub

Manuj35 · Answer

En faite dans le code que j'ai écris, il copie pas les données de "courbes" pour les collé dans "Reporting". Il va directement dans Reporting copie la plages de céllules spécifié et les colles la où je l'ai indiqué. La feuille étant vierge, je copie du vide. Comment le forcé a copié les céllules de la feuille "courbes" avant qu'il passe sur la feuille Reporting?

cs_MPi · Answer

OK, on va commencer par le début.
Je n'ai pas encore saisi le pourquoi des CompteurLigne1, CompteurLigne2,...

Disons que tu es dans la feuille Courbes quand la macro démarre
On va copier selon les critères que tu donnes sur la première ligne vide de ton autre feuille
Pour éviter le plantage (pour tout de suite), inscrit des entêtes sur la 1ere ligne de la feuille Reporting

    Dim I As Long, nbLignes As Long
    For I = 3 To 244   'sûrement à revoir...
         If Range("AH" & I) >= 20 Then
              Range("AF" & I & ":AH" & I).Copy
              nbLignes = Sheets("Reporting").Cells.Find _
                    ("*", Sheets("Reporting").Range("A1"), , , _
                     xlByRows, xlPrevious).Row + 1
              Sheets("Reporting").Range("A" & nbLignes).PasteSpecial
       
        ElseIf Range("AH" & I) >= 10 And Range("AH" & I) < 20 Then
              Range("AF" & I & ":AH" & I).Copy
              nbLignes = Sheets("Reporting").Cells.Find _
                    ("*", Sheets("Reporting").Range("A1"), , , _
                     xlByRows, xlPrevious).Row + 1
              Sheets("Reporting").Range("E" & nbLignes).PasteSpecial
    
        End If
    Next

C'est au moins un départ...
MPi

Copie de céllule suivant un critere

6 réponses

Votre réponse

Discussions similaires