Code VBA copier contenu des colonnes Excel vers un autre

Bonjour Forum

svp

comment avec le bouton import feuille R P1.xlsm ouvre( xls xlsx) son nom commence par Tempelate* la feuilee Data et detecte

la colonne "Nom" et copie Tout le contenu et le colle dans la colonne "Nom" de la feuille BD

la colonne "id" et copie Tout le contenu et le colle dans la colonne "id" de la feuille BD

la colonne "etap" et copie Tout le contenu et le colle dans la colonne "etap" de la feuille BD

la colonne "montant" et copie Tout le contenu et le colle dans la colonne "montant" de la feuille BD

et le code reste valide quel que soit le contenu du fichier Tempelate

Merci d'avance

SVP

Y a-t-il des suggestions?

MERCI

Hello,

Je n'ai pas testé mais voici une proposition :

Sub ImportData()
    Const strFichier$ = "template" 'Respecte la casse donc template different de Template, à vérifier donc
    Const strChemin$ = "C:\Users\Documents\VBA\" 'Modifier le chemin, ne pas oublier le \ à la fin
    Dim StrFile$
    Dim wkbBdd As Workbook
    Dim wksBd As Worksheet
    Dim lngRowBd&, lngRowTemplate&

    Set wksBd = Worksheets("BD")
    lngRowBd& = wksBd.Range("A" & wksBd.Rows.Count).End(xlUp).Row + 1
    StrFile = Dir(strChemin$)
    Do While Len(StrFile) > 0
        If Left(StrFile, Len(strFichier$)) = strFichier$ Then
            Set wkbBdd = Workbooks.Open(strChemin$ & StrFile)
            lngRowTemplate& = wkbBdd.Worksheets("Data").Range("G" & wksBd.Rows.Count).End(xlUp).Row
            wkbBdd.Worksheets("Data").Range("F11:F" & lngRowTemplate&).Copy wksBd.Range("B" & lngRowBd&)
            wkbBdd.Worksheets("Data").Range("G11:G" & lngRowTemplate&).Copy wksBd.Range("C" & lngRowBd&)
            wkbBdd.Worksheets("Data").Range("E11:E" & lngRowTemplate&).Copy wksBd.Range("D" & lngRowBd&)
            wkbBdd.Worksheets("Data").Range("I11:I" & lngRowTemplate&).Copy wksBd.Range("E" & lngRowBd&)
            Application.CutCopyMode = False
            wkbBdd.Close
            Exit Do
        End If
        StrFile = Dir
    Loop
    Set wkbBdd = Nothing
    Set wksBd = Nothing
    MsgBox "Copie réalisée"
End Sub

Bonsoir Rag02700, Bonsoir Forum

Merci infiniment Rag02700

svp

Est-il possible de modifier le code pour qu'il ne fonctionne qu'en plaçant le fichier "template" au même emplacement que le fichier " P1" path

et de ne commencer la copie qu'après avoir effacé les données précédentes B2:E (dernier cellule contient données dans la colonne E)et colle à partir de B2

Merci d'avance.

Voici :

Sub ImportData()
    Const strFichier$ = "template" 'Respecte la casse donc template different de Template, à vérifier donc

    Dim StrFile$, strChemin$
    Dim wkbBdd As Workbook
    Dim wksBd As Worksheet
    Dim lngRowBd&, lngRowTemplate&

    strChemin$ = ThisWorkbook.Path & "\"
    Set wksBd = Worksheets("BD")
    lngRowBd& = wksBd.Range("A" & wksBd.Rows.Count).End(xlUp).Row + 1
    wksBd.Range("B2:E" & lngRowBd&).ClearContents
    StrFile = Dir(strChemin$)
    Do While Len(StrFile) > 0
        If Left(StrFile, Len(strFichier$)) = strFichier$ Then
            Set wkbBdd = Workbooks.Open(strChemin$ & StrFile)
            lngRowTemplate& = wkbBdd.Worksheets("Data").Range("G" & wksBd.Rows.Count).End(xlUp).Row
            wkbBdd.Worksheets("Data").Range("F11:F" & lngRowTemplate&).Copy wksBd.Range("B2" )
            wkbBdd.Worksheets("Data").Range("G11:G" & lngRowTemplate&).Copy wksBd.Range("C2")
            wkbBdd.Worksheets("Data").Range("E11:E" & lngRowTemplate&).Copy wksBd.Range("D2")
            wkbBdd.Worksheets("Data").Range("I11:I" & lngRowTemplate&).Copy wksBd.Range("E2")
            Application.CutCopyMode = False
            wkbBdd.Close
            Exit Do
        End If
        StrFile = Dir
    Loop
    Set wkbBdd = Nothing
    Set wksBd = Nothing
    MsgBox "Copie réalisée"
End Sub

Bonsoir Rag02700, Bonsoir Forum

Merci infiniment Rag02700.