Réorganiser colonnes dans un ordre defini

Bonjour chers tous

Je voudrais remplir ma base finale "Base 2" a partir de ma base de départ "Base 1"

Les entêtes de la Base 1 se retrouvent dans les entêtes de la Base 2 mais pas dans le même ordre

Je voudrais le faire par macro vba .

Jai élaboré une macro mais qui fonctionne pas.

Veuillez m'aider a corriger cette macro..

Sub reorganiser()
Dim i As Long
Dim R As Range
Dim shFrom, wb As Worksheet
Dim dl As Long
Dim p2 As Range
Dim p1 As Range
Dim lig As Range
Dim ind
Dim dercolp2 As Long
Dim dercolp1 As Long

Set shFrom = ThisWorkbook.Worksheets("base 1") 'base depart
Set wb = ThisWorkbook.Worksheets("Base 2") 'Base finale organisée
dercolp2 = wb.Cells(2, Application.Columns.Count).End(xlToLeft).Column 'numero derniere colonne Base finale organisée
dercolp1 = shFrom.Cells(2, Application.Columns.Count).End(xlToLeft).Column 'numero derniere colonne Base depart
Set lig = wb.Cells(2, dercolp2) 'entetes Base finale organisée

With shFrom
dl = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 6 To dercolp1
        ind = .Cells(2, i)
        Set p1 = .Cells(3, i).Resize(dl)
        Set R = lig.Find(ind)
    If Not R Is Nothing Then
        Set p2 = wb.Range(R.Address).Offset(1).Resize(dl)
        p2 = p1
        Set p2 = Nothing
    End If
        Set p1 = Nothing
        Set R = Nothing
    Next i
End With
End Sub

Bonjour

Code à tester

Sub reorganiser()
    Dim i As Long
    Dim R As Range
    Dim shFrom As Worksheet, wb As Worksheet
    Dim dl As Long
    Dim p2 As Range
    Dim p1 As Range
    Dim lig As Range
    Dim ind As String
    Dim dercolp2 As Long
    Dim dercolp1 As Long

    Set shFrom = ThisWorkbook.Worksheets("base 1") ' base départ
    Set wb = ThisWorkbook.Worksheets("Base 2") ' Base finale organisée
    dercolp2 = wb.Cells(2, Application.Columns.Count).End(xlToLeft).Column ' numéro dernière colonne Base finale organisée
    dercolp1 = shFrom.Cells(2, Application.Columns.Count).End(xlToLeft).Column ' numéro dernière colonne Base départ
    Set lig = wb.Rows(2) ' entêtes Base finale organisée

    With shFrom
        dl = .Range("A" & .Rows.Count).End(xlUp).Row ' Dernière ligne utilisée dans la Base 1
        For i = 1 To dercolp1 ' Commencer à 1 pour inclure toutes les colonnes
            ind = .Cells(2, i).Value ' Récupérer l'entête de la Base 1
            Set R = lig.Find(ind, LookIn:=xlValues, lookat:=xlWhole) ' Chercher l'entête dans la Base 2
            If Not R Is Nothing Then
                Set p1 = .Cells(3, i).Resize(dl - 2) ' Récupérer les données à partir de la ligne 3
                Set p2 = wb.Cells(3, R.Column).Resize(dl - 2) ' Placer les données dans la Base 2
                p2.Value = p1.Value ' Copier les données
            End If
            Set R = Nothing
        Next i
    End With
End Sub

Ca fonctionne merci beaucoup.....

Si cela fonctionne passe le sujet en résolu

Cordialement