Untitled

mail@pastecode.io avatar
unknown
vbscript
10 months ago
2.5 kB
3
Indexable
Sub ajouter_button()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim nextEmptyRow As Long
    Dim totalHTRow As Long
    Dim TVA20Row As Long
    Dim TotalTTCRow As Long
    
    Set ws = ThisWorkbook.Sheets("Nom_de_votre_feuille") ' Remplacez "Nom_de_votre_feuille" par le nom de votre feuille
    
    If Range("K8") = "" Or Range("K9") = "" Or Range("K10") = "" Or Range("K11") = "" Or Range("K12") = "" Then
        MsgBox ("Des informations manquantes")
    Else
        ' Recherche de la dernière ligne utilisée dans la colonne B
        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        
        ' Trouver la prochaine ligne vide dans la colonne B
        If lastRow < 10 Then
            nextEmptyRow = 10
        Else
            nextEmptyRow = lastRow + 1
        End If
        
        ' Vérifier si "Total HT", "TVA 20%" et "Total TTC" sont sur la même ligne que la prochaine ligne vide
        totalHTRow = Application.Match("Total HT", ws.Columns("E"), 0)
        TVA20Row = Application.Match("TVA 20%", ws.Columns("E"), 0)
        TotalTTCRow = Application.Match("Total TTC", ws.Columns("E"), 0)
        
        If Not IsError(totalHTRow) And totalHTRow = nextEmptyRow Then
            ' Déplacer la ligne "Total HT" vers le bas d'une ligne
            ws.Rows(totalHTRow).Copy
            ws.Rows(totalHTRow + 1).Insert Shift:=xlDown
            ws.Rows(totalHTRow).Delete
        End If
        
        If Not IsError(TVA20Row) And TVA20Row = nextEmptyRow Then
            ' Déplacer la ligne "TVA 20%" vers le bas d'une ligne
            ws.Rows(TVA20Row).Copy
            ws.Rows(TVA20Row + 1).Insert Shift:=xlDown
            ws.Rows(TVA20Row).Delete
        End If
        
        If Not IsError(TotalTTCRow) And TotalTTCRow = nextEmptyRow Then
            ' Déplacer la ligne "Total TTC" vers le bas d'une ligne
            ws.Rows(TotalTTCRow).Copy
            ws.Rows(TotalTTCRow + 1).Insert Shift:=xlDown
            ws.Rows(TotalTTCRow).Delete
        End If
        
        ' Ajouter les valeurs des cellules K9 à K12 au tableau commençant à la ligne nextEmptyRow
        ws.Cells(nextEmptyRow, "B").Value = Range("K9").Value
        ws.Cells(nextEmptyRow, "C").Value = Range("K10").Value
        ws.Cells(nextEmptyRow, "D").Value = Range("K11").Value
        ws.Cells(nextEmptyRow, "E").Value = Range("K12").Value
        
        MsgBox ("Valeurs ajoutées avec succès.")
    End If
End Sub
Leave a Comment