Macro transfert de ligne

Bonjour à tous,

J'aurai besoin d'un peu d'aide sur le fichier joint.

Mon but étant par du VBA de faire un copier/coller/supprimer ou couper/coller une (ou plusieurs lignes ) complète(s) de l'onglet ENCOURS sur l'onglet ARCHIVAGE sous réserve de noter une indication dans une colonne.

Exemple:

Je veux archiver la ligne 8, 11 , 17 et 24. Je note donc le mot "OK" par exemple dans la colonne archivage sur chacune des lignes correspondantes et puis je lance manuellement ma commande VBA par le bouton dédié. La macro devra sélectionner les 4 lignes choisies et:

• soit les couper et les insérer à la suite des lignes précédents dans l'onglet ARCHIVES
• soit les copier et les coller à la suite des lignes précédents dans l'onglet ARCHIVES et de supprimer les lignes dans l'onglet EN COURS.

J'ai récupérer une formule dans le fichier d'un collègue qui est ressemblant au fonctionnement que je souhaiterais, mais n'étant ap assez calé en VBA j'ai une erreur de code.

Merci par avance de votre aide.

Bonjour,

Essaie avec ce code

Sub Transfert()
'
' Transfert Macro
    Application.ScreenUpdating = False
    Dim dlg As Integer, lg As Integer, i As Integer
    With ActiveSheet
        dlg = .Range("A" & Rows.Count).End(xlUp).Row
        For i = dlg To 2 Step -1
            If UCase(Range("O" & i)) = "OK" Then
                lg = Sheets("ARCHIVAGE").Range("B" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":P" & i).Copy Sheets("ARCHIVAGE").Range("B" & lg)
                .Rows(i).Delete

             End If

        Next
    End With
End Sub

Cdt

Bonjour,

L'erreur provient de cette ligne de code où la plage est mal définie:

.Range("A" & i & "P" & i).Copy Sheets("ARCHIVAGE").Range("A" & lg)

modifier comme ceci:

.Range("A" & i & ":P" & i).Copy Sheets("ARCHIVAGE").Range("A" & lg)

A+

Edit : bonjour ddetp88

Bonjour nico5310, le forum,

Si tu supprimes ta colonne A de la feuille ARCHIVAGE, ton code fonctionne.

Si tu souhaites la conserver:

Tu définis ta dernière ligne (lg) de la feuille ARCHIVAGE en fonction de la colonne A qui contient des n°, ce serait plutôt B.

Tu colles ensuite tes lignes à partir de la colonne A de la feuille ARCHIVAGE alors qu'il faudrait les coller à partir de la colonne B.

Proposition à partir de ta macro:

Sub Transfert()
' Transfert Macro
 Dim dlg As Integer, lg As Integer, i As Integer

 lg = Sheets("ARCHIVAGE").Range("B" & Rows.Count).End(xlUp).Row + 1

    Application.ScreenUpdating = False

    With ActiveSheet
      dlg = .Range("A" & Rows.Count).End(xlUp).Row
        For i = dlg To 2 Step -1
         If UCase(Range("O" & i)) = "OK" Then
            .Range("A" & i & ":O" & i).Copy Sheets("ARCHIVAGE").Range("B" & lg)
            .Rows(i).Delete
            lg = lg + 1
          End If
        Next i
    End With

    With Sheets("ARCHIVAGE")  'pour la numérotation en colonne A
     .Range("A2") = 1
      For i = 3 To lg - 1
       .Range("A" & i) = .Range("A" & i - 1) + 1
      Next i
    End With
End Sub

Cordialement,

EDIT: Bonjour ddetp88 et AlgoPlus,

C'est parfait , merci pour votre aide.

Je voudrais rajouter une fonction sur mon tableau et insérer un colonne en J avec un chiffre dans ces colonnes correspondant aux nombre d'emplacements pris sur un camion pour chaque véhicule.

Je voudrais pouvoir calculer manuellement avec un bouton calculer le nombre d'emplacements utilisés mais en fonction des jours, donc en utilisant un filtre sur la colonne K.

Je viens donc de faire une nouvelle macro, mais cela ne tient pas compte du filtre utilisé ou pas

Re,

A tester.....nb.si....

Sub Somme()
 Dim résultat As Integer, dl As Long
 Dim plagesomme As Range, plageCritère As Range

With Sheets("EN COURS")
 dl = .Range("A" & Rows.Count).End(xlUp).Row
 Set plagesomme = .Range("J2:J" & dl)
 Set plageCritère = .Range("P2:P" & dl)
 resultat = Application.WorksheetFunction.SumIf(plageCritère, "OK", plagesomme)
End With

 MsgBox resultat & " place(s)"
End Sub

Une variante pour le transfert (on filtre sur la colonne P et on transfert les lignes visibles).

Sub Transfert()

 Dim dl1 As Long, dl2 As Long, a As Integer

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

   With Sheets("ARCHIVAGE")
    dl2 = .Range("A" & Rows.Count).End(xlUp).Row + 1
   End With

   With Sheets("EN COURS")
    dl1 = .Range("A" & Rows.Count).End(xlUp).Row
      a = Application.WorksheetFunction.CountIf(Range("P2:P" & dl1), "OK")
    If a > 0 Then
     If MsgBox("Etes-vous certain de vouloir supprimer et archiver ces " & a & " lignes ?", vbYesNo, "Demande de confirmation") = vbYes Then
      .Range("A2:P" & dl1).AutoFilter field:=16, Criteria1:="OK"
      .Range("A2:P" & dl1).SpecialCells(xlVisible).Copy Sheets("ARCHIVAGE").Range("A" & dl2)
      .Range("A2:P" & dl1).SpecialCells(xlVisible).Delete
      If .FilterMode = True Then .ShowAllData
     End If
    Else
     MsgBox "Aucune ligne à archiver"
    End If
   End With

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Cordialement,

Bonjour,

Merci pour ton retour, je me suis mal exprimé.

En fait j'ai besoin de compter le nombre de véhicule en colonne J lorsque j'active le filtre de la colonne K.

Par exemple, si je sélectionnes le 06/01 et que je clique sur mon bouton, je devrais voir affiché 18 .

Re,

Merci pour ton retour, je me suis mal exprimé.

Je te rassure, c'est moi qui ai lu trop vite,

Une simple formule devrait suffire....

Par exemple en S1:

=SOUS.TOTAL(9;J:J)

Si tu filtres, tu obtiens bien 18, sinon 56.

Tu peux si tu le souhaites, récupérer la valeur dans une msgbox,

Cordialement,

Magnifique !

Merci pour ton aide,

Bonne journée

Re,

Sans cellule intermédiaire....

Sub Somme()
 Dim r
  r = Application.WorksheetFunction.Subtotal(9, Range("J:J"))
  MsgBox r & " places"
End Sub

Cordialement,