Réorganiser et corriger un tableau avec des erreurs via VBA

Bonjour à tous,

Voici mon problème dans le cadre d'un projet de gestion de base de données, je me retrouve confronté à des problèmes d'extractions dans un tableau assez volumineux.

Mon tableau est constitué de 14 colonnes et 260'456 lignes.

Je vous mets en fichier un exemple de quelques lignes auquel je suis confronté.

Le ficher est en 3 onglets : le premier est la situation initiale brut, le second une explication des erreurs constatés et le 3e est le résultat que je souhaite obtenir.

Une piste pour résoudre ce problème est la suivante, dans des tableaux du même type, j'avais l'habitude d'utiliser ce code VBA pour parvenir à corriger mon tableau qui était plus simple que ce dernier.

Mais je n'arrive pas à le faire en sorte que la suppression des lignes ne se fasse pas colonnes par colonnes mais bien que sur l'analyse des premières colonnes pour ensuite copier le reste de la ligne en un bloc.

Voici le code :

Option Explicit 

Sub DeleteBlanks() 
    Dim intCol As Integer 

    For intCol = 1 To 4 'cols A to D
        Range(Cells(2, intCol), Cells(146521, intCol)). _ 
        SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 
    Next intCol 
End Sub 

Je vous remercie d'avance pour votre aide.

Cordialement,

James aka Newbie2000

Bonjour et bienvenue sur le forum

Essaie ce code :

Option Explicit
Dim ln, derLn, j, flag

Sub MiseEnForme()
    derLn = Range("A" & Rows.Count).End(xlUp).Row
    For ln = derLn To 2 Step -1
        If Range("B" & ln) = "" Then
            flag = 0
            For j = 1 To 5
                If Cells(ln, j).Value <> "" Then
                    flag = 1
                End If
            Next j
            If flag = 0 Then
                'Cas de la ligne blanche
                Rows(ln & ":" & ln).Delete shift:=xlUp
            Else
                Cells(ln, "A").Copy Cells(ln + 1, "A")
                Rows(ln & ":" & ln).Delete shift:=xlUp
            End If
        End If
    Next ln
End Sub

Bonjour Newbie, Gmb, bonjour le forum,

Une proposition très similaire de celle de Gmb :

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Long 'déclare la variable I (Incrément)

Set O = Sheets("Situation Initiale") 'définit l'onglet O (à adapter)
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A2:A" & DL) 'définit la palge PL
For I = DL To 2 Step -1 'boucle inversée de la ligne DL à la ligne 2 par pas de un
    'agit en fonction du nombre de cellules vide dans la plage des colonnes A à N
    Select Case Application.WorksheetFunction.CountBlank(Cells(I, 1).Resize(, 14))
        Case 13 'cas 13 cellules vide
            'copie la plages des colonnes B à N de la ligne en dessous dans la cellule colonne B de la ligne
            Cells(I, 1).Offset(1, 1).Resize(, 13).Cut Cells(I, 1).Offset(0, 1)
            Rows(I + 1).Delete 'supprime la ligne en dessous
        Case 14 'cas 14
            Rows(I).Delete 'supprime la ligne
    End Select 'fin de l'action en fonction de...
Next I 'prochaine ligne de la boucle
End Sub

Je n'ai qu'une chose à dire : BLUFFANT.

J'ai déjà constaté une autre erreur grâce a ton code gmb dans ma base de données mais qui est facilement corrigeable pour moi.

Je vais continuer mes testes et si je suis à nouveau bloqué je me permettrais de reposer une question à la suite.

Mais pour l'instant ça semble marcher parfaitement.

Je te remercie gmb.

ThauThème, je vais voir ce que peut m'apporter ton code aussi. Merci pour ta réponse

Merci beaucoup pour la rapidité et la qualité de vos réponses.

Je vous souhaite une bonne fin de matinée.

Et en espérant ne pas avoir besoin de vous à nouveau trop vite

Même si j'apprends énormément

Cordialement,

James.