Erreur lors de la copie de données

bonjour le forum,

je poste ici une nouvelle fois car j'ai une erreur lors de la copie, alors que j'ai 7 colonnes avec plus de 100 ligne à importer de mon fichier "Programme_Exp" feuille (1) vers mon fichier"PROGRAMME TRANSPORT" feuille (5) ; celle ci ne se copie pas, je n'ai pas d'erreur qui apparait .... rien le néant , il copie dans le vide on dirait !

je vous joints la macro

Private Sub Extraction_Douanes_Click()

    '!!!!partie ouverture des fichiers à créer

'--------------------------------------
'Détermination du fichier à importer

    qui

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Fichiers Excel", "*.xls*"
        .Title = "Merci de définir le fichier d'expédition à importer"
    End With

    If fd.Show = 0 Then
        MsgBox "Vous n'avez sélectionné aucun fichier"

        Exit Sub
    Else
        file_mere_pth = fd.SelectedItems(1)
        Workbooks.Open file_mere_pth
        file_mere = ActiveWorkbook.Name
    End If

    Set exp = Workbooks(file_mere).Sheets("P+E")
    Set transport = Workbooks(file_source).Sheets("DOUANES")

    nb_ligne_exp = exp.UsedRange.Rows.Count
    nb_colonne_exp = exp.UsedRange.Columns.Count

    nb_ligne_transport = transport.UsedRange.Rows.Count
    nb_colonne_transport = transport.UsedRange.Columns.Count

    For i = 4 To nb_ligne_exp
        If exp.Cells(i, 1) = "" Then
            nb_ligne_exp = i
            Exit For
        End If
    Next i

    For y = 6 To nb_ligne_transport
        If transport.Cells(y, 8) = "" Then
            nb_ligne_transport = y
            Exit For
        End If
    Next y

    For i = 4 To nb_ligne_exp
        of_bool = False

        For y = 6 To nb_ligne_transport
            'Si n°OF retrouvé alors exit for sinon création
            If exp.Cells(i, 1) = transport.Cells(y, 8) And exp.Cells(i, 2) = transport.Cells(y, 9) Then
                of_bool = True
                Exit For

                of_bool = True
                Exit For
            Else

            End If

            If of_bool = True Then
                Exit For
            End If
        Next y

        nb_ligne_transport = Workbooks("PROGRAMME TRANSPORT.xlsm").Sheets("DOUANES").UsedRange.Rows.Count

        For y = 6 To nb_ligne_transport
            If transport.Cells(y, 8) = "" Then
                nb_ligne_transport = y
                Exit For
            End If
        Next y

        If of_bool = False Then

            transport.Cells(y, 2) = exp.Cells(i, 1)
            transport.Cells(y, 3) = exp.Cells(i, 2)
            transport.Cells(y, 4) = exp.Cells(i, 4)
            transport.Cells(y, 5) = exp.Cells(i, 6)
            transport.Cells(y, 6) = exp.Cells(i, 16)
            transport.Cells(y, 7) = exp.Cells(i, 17)
            transport.Cells(y, 8) = exp.Cells(i, 22)

        End If

    Next i

    Workbooks(file_mere).Close False

    MsgBox ("Importation des données relative aux douanes est terminée")

    Unload Me

End Sub 

je vous joints mes fichier pour vous rendre compte

merci de votre

a vous lire

Pipin54000

Bonjour,

Les données sont écrient toujours à la ligne 6 de la feuille Douanes (écrasement des données)

Je tentes de trouver l'erreur.

ric

Bonjour à tous,

Si tu déclare Dl as long au début, pour permettre d'incrémenter la ligne de la feuille Douanes.

        For y = 6 To nb_ligne_transport
            If transport.Cells(y, 8) = "" Then
                nb_ligne_transport = y
                Exit For
            End If

        Next y
        If of_bool = False Then
            Dl = Workbooks("PROGRAMME TRANSPORT.xlsm").Worksheets("Douanes").Cells(Rows.Count, 2).End(xlUp).Row + 1
            transport.Cells(dl, 2) = exp.Cells(i, 1)
            transport.Cells(dl, 3) = exp.Cells(i, 2)
            transport.Cells(dl, 4) = exp.Cells(i, 4)
            transport.Cells(dl, 5) = exp.Cells(i, 6)
            transport.Cells(dl, 6) = exp.Cells(i, 16)
            transport.Cells(dl, 7) = exp.Cells(i, 17)
            transport.Cells(dl, 8) = exp.Cells(i, 22)
        End If

ric

ric,

merci pour ton retour, je test tout ça demain matin et te dis quoi

a te lire,

Pipin54000

c'est ok merci pour ton aide

Pipin54000