Importer textes cellules sans cellules vides

Bonjour,

Pour l’exécution du code je crois comprendre le problème, la suppression des lignes lors de l’exécution des codes, l’un effacera l’autre et inversement, miel je n’y avait pensé… Il est en effet préférable de pouvoir exécuter dans n’importe quel ordre. Miel...

Voici le premier code modifié (donc colonnes A à L).

Sub Importer()
Dim dlg As Integer, lg As Integer, i As Integer
Dim rng As Range
Dim lig As Byte

With Sheets("Retour")
    .Range("A:C").ClearContents 'effacer colonnes A à C dans la feuille Retour
    .Range("A:A").Interior.Color = xlNone
End With

With ActiveSheet
    dlg = .Range("A" & Rows.Count).End(xlUp).Row 'trouver derniere ligne colonne A
    Set rng = .Range("A1:C" & dlg) 'definir plage rng
End With
rng.Copy 'copier plage rng

With Sheets("Retour")
    .Range("A1").PasteSpecial Paste:=xlPasteValues 'coller plage rng sans formules
    dlg = .Range("A" & Rows.Count).End(xlUp).Row 'trouver derniere ligne colonne A

    'suppression de lignes entre colonnes A et L si cellule colonne A vide
    For i = dlg To 2 Step -1
        If IsEmpty(.Range("A" & i)) Then
            .Range("A" & i & ":L" & i).Delete shift:=xlUp
        End If
    Next i

    dlg = .Range("A" & Rows.Count).End(xlUp).Row 'trouver derniere ligne

    'definir plage pour recherche premiere ligne contenant le mot fournisseur
    Set rng = .Range("A2:A" & dlg)
    On Error Resume Next 'gestion erreur au cas où lig = 0
    lig = rng.Find("*Fournisseur*", LookIn:=xlValues, lookat:=xlWhole).Row
    If lig = 0 Then Exit Sub 'sortie du code si pas de ligne trouvee avec mot Fournisseur
    On Error GoTo 0

    .Range("A" & lig & ":L" & lig + 4).Delete shift:=xlUp 'Supprimer lignes entre colonnes A et L

    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("D2:L2").AutoFill Destination:=.Range("D2:L" & dlg), Type:=xlFillDefault 'recopier formule entre colonne E et L

    Set rng = .Range("A2:A" & lig) 'définir la plage de recherche pour articles ajoutés dans Com1-Fournisseur

    For i = dlg To lig Step -1
        If .Range("A" & i) Like "*Fournisseur*" Then
            .Range("A" & i & ":L" & i).Delete shift:=xlUp 'supprimer le residu des cellules contenant "Fournisseur" en colonne A
        Else
            On Error Resume Next
            lg = rng.Find(.Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole).Row 'trouver ligne contenant la valeur de cellule en colonne A

            If lg > 0 Then
                If .Range("C" & i) = .Range("C" & lg) Then 'verifier si prix identique
                    .Range("B" & lg) = .Range("B" & i) + .Range("B" & lg) 'ajouter quantite
                    .Range("A" & i & ":L" & i).Delete shift:=xlUp 'supprimer lignes
                    lg = 0
                ElseIf .Range("C" & i) <> .Range("C" & lg) Then 'verifier si prix différent
                    .Range("A" & i).Interior.Color = 8696052 'ajout couleur marron
                End If
            End If

        End If
    Next i
End With
End Sub

J'ai ajouté quelques commentaires
Refaite un test.
Si ok, je vous donnerai l'autre code qui concernera les colonnes N à X (merci de confirmer)

Fonctionne parfaitement ! Merci Dan !

Et re merci pour les commentaires. Je vais "décrypter" tout cela.

Bien à vous

Vincent

Voici pour le code pour Colruyt (donc de la colonne N à X)

Sub Importer4()
Dim dlg As Integer, lg As Integer, i As Integer
Dim rng As Range
Dim lig As Byte

With Sheets("Retour")
    .Range("N:P").ClearContents 'effacer colonnes N, O, P dans la feuille Retour
    .Range("N:N").Interior.Color = xlNone
End With

With ActiveSheet
    dlg = .Range("M" & Rows.Count).End(xlUp).Row 'trouver derniere ligne colonne N
    Set rng = .Range("M1:O" & dlg) 'definir plage rng
End With
rng.Copy 'copier plage rng

With Sheets("Retour")
    .Range("N1").PasteSpecial Paste:=xlPasteValues 'coller plage rng sans formules
    dlg = .Range("N" & Rows.Count).End(xlUp).Row 'trouver derniere ligne colonne N

    'suppression de lignes entre colonnes N et X si cellule colonne N vide
    For i = dlg To 2 Step -1
        If IsEmpty(.Range("N" & i)) Then
            .Range("N" & i & ":X" & i).Delete shift:=xlUp
        End If
    Next i

    dlg = .Range("N" & Rows.Count).End(xlUp).Row 'trouver derniere ligne colonne N

    'definir plage pour recherche premiere ligne contenant le mot fournisseur
    Set rng = .Range("N2:N" & dlg)
    On Error Resume Next 'gestion erreur au cas où lig = 0
    lig = rng.Find("*Fournisseur*", LookIn:=xlValues, lookat:=xlWhole).Row
    If lig = 0 Then Exit Sub 'sortie du code si pas de ligne trouvee avec mot Fournisseur
    On Error GoTo 0

    .Range("N" & lig & ":X" & lig + 4).Delete shift:=xlUp 'Supprimer lignes

    dlg = .Range("N" & Rows.Count).End(xlUp).Row
    .Range("Q2:X2").AutoFill Destination:=.Range("Q2:X" & dlg), Type:=xlFillDefault 'recopier formule entre colonne Q et X

    Set rng = .Range("N2:N" & dlg) 'définir la plage de recherche pour articles ajoutés dans Com1-Colruyt

    For i = dlg To lig Step -1
        If .Range("N" & i) Like "*Colruyt*" Then 'supprimer le residu des cellules contenant "Colruyt"
            .Range("N" & i & ":X" & i).Delete shift:=xlUp 'supprimer donnees entre colonne N et X
        Else
            On Error Resume Next
            lg = rng.Find(.Range("N" & i).Value, LookIn:=xlValues, lookat:=xlWhole).Row 'trouver ligne contenant la valeur de cellule en colonne N

            If lg > 0 Then
                If .Range("P" & i) = .Range("P" & lg) Then 'verifier si prix identique
                    .Range("O" & lg) = .Range("O" & i) + .Range("O" & lg) 'ajouter quantite
                    .Range("N" & i & ":X" & i).Delete shift:=xlUp 'supprimer donnees entre colonne N et X
                    lg = 0
                ElseIf .Range("P" & i) <> .Range("P" & lg) Then 'verifier si prix différent
                    .Range("N" & i).Interior.Color = 8696052 'ajout couleur marron
                End If
            End If
        End If
    Next i
End With
End Sub

crdlt

Bonjour Dan,

Petits soucis, l'importation de la commande fonctionne bien mais pas l'ajout de commande.

Le bout de code Set rng = .Range("N2:N" & dlg) 'définir la plage de recherche pour articles ajoutés dans Com1-Colruyt ne contiendrais t'il pas une erreur ?

Range("N2:N" & dlg) ne devrait-il pas être Range("N2:N" & lig) ?

Quand je met avec "lig" il comptabilise les articles identiques avec même prix, par contres les autres articles qui ne sont pas repris dans la commande principale ou avec prix différent, ne sont pas importés.

Pour le reste tout semble ok.

Merci encore.

Bien à vous

Vincent

Bonjour

Petits soucis, l'importation de la commande fonctionne bien mais pas l'ajout de commande....
Range("N2:N" & dlg) ne devrait-il pas être Range("N2:N" & lig) ?

Effectivement il faut remplacer dlg par Lig
Désolé mais j'avais préparé un autre code que j'ai abandonné suite aux réponses que vous avez données à mes questions dans un post précédent.
Par contre très important, vous devez absolument avoir des données dans les cellules M40, M41, M43 et M44. Idem pour la colonne A.
Je viens de faire un test sur les deux codes. Si il vous manque le nom du fournisseur en ligne 41 ou l'acompte, le code va vous renvoyer de mauvais résultat.
Donc pas cellule vide à cet endroit !!

Si cela peut arriver, il faudra rajouter des lignes de code pour vérifier que les données sont bien présentes

Crdlt

Génialllll ! Tout fonctionne, bien vu, en effet une cellule était vide !

Dan, un tout, tout grand merci, au delà de vos connaissances, pour votre patience, je sais être parfois maladroit dans mes explications.

Problème résolu

Belle journée à vous

Vincent