Mise au point et fin d'une macro

sam130242 Messages postés 72 Date d'inscription Statut Membre Dernière intervention -
Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention - 11 juin 2016 à 06:43

Bonjour,
pouvez vous m'aider à mettre au point cette macro "TRANSFERT"
1/Le traitement est conditionné par une égalité entre les cellules et B4 et D4.
En cas d'inégalité, je dois afficher un message (msgbox) pour abandonner le traitement et sortir de la macro

2/elle sélectionne les lignes de ENCOURS dont la notif (col H) = référence en A4
(3 lignes répondent à cette sélection)

3/Ces 3 lignes sont transférées dans l'onglet HISTO à partir de la 1ère ligne vide dispo.

4/on tri ce fichier HISTO enrichi de 3 nouvelles lignes
en l'état, la macro est triée sur H4 : je n'arrive pas à trouver la syntaxe pour ajouter les 3 critères suivants qui sont en commentaire.

L'exécution de cette macro fonctionne pour les cas 2 et 3 et le tri mono-critère.
le cas 1 affiche : variable non définie pour B4 et D4

merci de votre coup de main
sm

https://www.cjoint.com/c/FFkxsgu1xxe

Afficher la suite

A voir également:

Mise au point et fin d'une macro
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Mise en forme conditionnelle excel - Guide
Mise a jour chrome - Accueil - Applications & Logiciels
Mise a jour windows 10 - Accueil - Mise à jour
Point de suite word - Guide

1 réponse

Réponse 1 / 1

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

Bonjour
Pour le test de B4 et D4, mettre entre crochets
Pour le tri, utilisez l'enregistreur de macro
Après MsgBox, pas de signe =

Option Explicit
Dim num_lign, lign_disp, DerLig

Sub Transfert()
    If [B4] = [D4] Then                                                             'égalité montant rlv et montant progressif
        For num_lign = 6 To Range("A" & Rows.Count).End(xlUp).Row               'on délimite la plage de ENCOURS
            If Range("H" & num_lign) = Range("A4") Then                             'on sélectionne les n° de relevé
                lign_disp = Sheets("HISTO").Range("A" & Rows.Count).End(xlUp)(2).Row      'position sur 1ere ligne dispo de HISTO
                Range("A" & num_lign & ":K" & num_lign).Copy Sheets("HISTO").Range("A" & lign_disp) 'copy la ligne ENCOURS sur HISTO
                Range("A" & num_lign & ":K" & num_lign).Delete Shift:=xlUp          'suppression cette ligne sur ENCOURS
            End If
        Next num_lign
        
        'tri sur HISTO
        Sheets("HISTO").Select
        DerLig = [A1000000].End(xlUp).Row
        With Range("A4:K" & DerLig).Select
            ActiveWorkbook.Worksheets("HISTO").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("HISTO").Sort.SortFields.Add Key:=Range("H4:H" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("HISTO").Sort.SortFields.Add Key:=Range("A4:A" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("HISTO").Sort.SortFields.Add Key:=Range("G4:G" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            ActiveWorkbook.Worksheets("HISTO").Sort.SortFields.Add Key:=Range("J4:J" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("HISTO").Sort
                .SetRange Range("A4:K" & DerLig)
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
    Else
        MsgBox "terminer pointage en cours - abandon du transfert"             'message abandon et sortie du transfert
    End If
End Sub

Cdlt

Discussions similaires

Snapchat que veux dire le petit point vert

Votre réponse

Discussions similaires