Copier les données d'une feuille vers une autre dans un même fichier

Merci beaucoup c'est vraiment super bien fait et surtout super gentil !!

Je veux bien que vous le mettiez sur l'autre fichier si ça ne vous dérange pas.

Est-ce que au moins le résultat attendu est le bon ?

Voilà le code, il te faut juste ajouter le code dans un module standard du fichier où se trouve la feuille source et de créer la feuille "IMPORT" pour accueillir les données restructurées (Je donne mon avis, c'est quand même beaucoup plus risqué de travailler directement sur le fichier source, nous ne sommes jamais à l'abri d'une corruption de données, il est toujours préférable de passer par un classeur tiers).

Si le code te conviens alors c'est parfait !

Sub StructurationDatas()
Dim WbExport As Workbook
Dim WsExport As Worksheet, WsImport As Worksheet, WsTransco As Worksheet
Dim NomFeuille As String, PremCol As String, DernCol As String, MSG As String, Jour As String, Mois As String, Annee As String
Dim i As Long, j As Long, PremLig As Long, DernLig As Long
Dim FeuilleExiste As Boolean
Dim TblExport() As Variant, TblImport() As Variant, TblEntete() As Variant, TblTransco() As Variant

    Set WbExport = ThisWorkbook

    'Nous allons vérifier l'existance de la feuille où nous allons importer les données
    NomFeuille = "IMPORT"
    FeuilleExiste = False
    For i = 1 To WbExport.Worksheets.Count  'Boucle sur les feuille du classeur
        If WbExport.Worksheets(i).Name = NomFeuille Then FeuilleExiste = True: Exit For 'Test si feuille existe
    Next i
    If FeuilleExiste = True Then 'Si la feuille existe
        Set WsImport = WbExport.Worksheets(NomFeuille) 'La variable WsImport représente la fuille d'importation
    Else 'Si elle n'existe pas
        MsgBox "Impossible de trouver la feuille """ & NomFeuille & """ dans le classeur, elle a pu être déplacée, renommée ou supprimée. Merci d'en créer une avant de poursuivre.", vbCritical
        Exit Sub
    End If
    MSG = MsgBox("L'extraction nécéssite la suppression des données présentent sur la feuille """ & WsImport.Name & """. Continuer le processus d'extraction ?", vbExclamation + vbYesNoCancel)
    If MSG = vbYes Then WsImport.Cells.Clear: WsImport.Cells.Delete Shift:=xlUp Else Exit Sub 'Les données issues de précédentent extraction sont supprimées

    'Maintenant que le classeur est ouvert est identifié par la variable WbExport
    'Nous allons vérifier que la feuille où se trouve les datas à importer existe aussi
    NomFeuille = "Source" 'A ajuster
    FeuilleExiste = False
    For i = 1 To WbExport.Worksheets.Count  'Test si feuille existe
        If WbExport.Worksheets(i).Name = NomFeuille Then FeuilleExiste = True: Exit For
    Next i
    If FeuilleExiste = True Then 'Si la feuille existe
        Set WsExport = WbExport.Worksheets(NomFeuille)
    Else 'Si elle n'existe pas
        MsgBox "Impossible de trouver la feuille """ & NomFeuille & """ dans le classeur, elle a pu être déplacée, renommée ou supprimée.", vbCritical
        Exit Sub
    End If

    'Nous allons vérifier que la feuille où se trouve les transcodages client existe aussi
    NomFeuille = "Transco num code client"
    FeuilleExiste = False
    For i = 1 To WbExport.Worksheets.Count  'Test si feuille existe
        If WbExport.Worksheets(i).Name = NomFeuille Then FeuilleExiste = True: Exit For
    Next i
    If FeuilleExiste = True Then 'Si la feuille existe
        Set WsTransco = WbExport.Worksheets(NomFeuille)
    Else 'Si elle n'existe pas
        MsgBox "Impossible de trouver la feuille """ & NomFeuille & """ dans le classeur, elle a pu être déplacée, renommée ou supprimée.", vbCritical
        Exit Sub
    End If

    'Maintenant que la feuille source ainsi que la feuille de transcodage sont identifiées nous allons définir les plages de données à analyser
    'Pour se faire nous allons féfinir les colonnes et les lignes pour borner la plage
    'Pour le transcodage :
    PremCol = "A" 'A ajuster
    DernCol = "C" 'A ajuster
    PremLig = 3 'A ajuster
    DernLig = WsTransco.Range(PremCol & WsTransco.Rows.Count).End(xlUp).Row
    TblTransco = WsTransco.Range(PremCol & PremLig & ":" & DernCol & DernLig).Value 'Chargement des données de transcodage dans le tableau

    'Pour la feuille source :
    PremCol = "A" 'A ajuster
    DernCol = "G" 'A ajuster
    PremLig = 2 'A ajuster
    DernLig = WsExport.Range(PremCol & WsExport.Rows.Count).End(xlUp).Row
    TblExport = WsExport.Range(PremCol & PremLig & ":" & DernCol & DernLig).Value 'Chargement des données source dans le tableau

    'Création du tableau d'entêtes
    TblEntete = Array("DIRECTION", "DATE DE LIVR. 1", "DATE DE LIVR. 2", "BL", "POOL", "REFERENCE", "QUANTITE", "RECEPTIONNAIRE", "MON N° IFCO") 'A ajuster

    ReDim TblImport(1 To UBound(TblExport), 1 To UBound(TblEntete) + 1) 'Dimentionnement du tableau d'importation
    For i = LBound(TblImport) To UBound(TblImport) 'Boucle sur toutes les lignes du nouveau tableau pour écrir les nouvelles données dedans
        TblImport(i, 1) = "S"
        Jour = Right(TblExport(i, 2), 2)
        Mois = Mid(TblExport(i, 2), 2, 2)
        Annee = Left(TblExport(i, 2), 4)
        TblImport(i, 2) = Jour & "." & Mois & "." & Annee
        TblImport(i, 3) = TblImport(i, 2)
        TblImport(i, 4) = CStr(Left(TblExport(i, 1), 3) & Right(TblExport(i, 1), 3))
        TblImport(i, 5) = 9
        TblImport(i, 6) = "BLL6410"
        TblImport(i, 7) = TblExport(i, 7)
        For j = LBound(TblTransco) To UBound(TblTransco)
            If TblTransco(j, 1) = TblExport(i, 3) Then TblImport(i, 8) = TblTransco(j, 3): Exit For
        Next j
        If TblImport(i, 8) = "" Then TblImport(i, 8) = "Pas de transco"
        TblImport(i, 9) = CStr(616095)
    Next i
    WsImport.Range("A1").Resize(1, UBound(TblEntete) + 1) = TblEntete
    WsImport.Range("A2").Resize(UBound(TblImport, 1), UBound(TblImport, 2)) = TblImport
End Sub

J'ai encore optimisé le code, récupère le code qui se trouve dans le module 2 du fichier joint, il est adapté à ton besoin

C'est parfait ! Je vais bien le regarder pour mieux comprendre et pouvoir m'en inspirer les prochaines fois.

Parfait alors, si ton problème est résolu n'oublie pas le cliquer sur le petit à côté d'un des messages