Recopie automatique d'infos d'un formulaire vers une BDD

Bonjour à tous,

Après avoir fait de nombreuses recherches sur le net, je m’en remets à la sagacité de vos esprits concernant mon fichier Excel car je n’ai pas réussi à trouver la solution.

Si le sujet a déjà été traité, je suis par avance désolée (j’ai cherché sur le forum mais pas trouvé).

Je reçois des demandes de réservation de vol via un tableau Excel et les infos sont ensuite capitalisées dans un autre tableau global qui recense tous les vols réservés.

Pour chaque réservation :

• je copie les infos du formulaire (onglet FORMULAIRE dans mon fichier en pj)

• que je colle ensuite dans la BDD (onglet BDD).

Je souhaite automatiser cette étape de copier-coller incessante (beaucoup de réservations tous les jours), avez-vous des suggestions svp ?

Merci de m’avoir lue

Anna

Bonjour Anna,

Je te propose :

• De ne pas recopier les demandes de voyages dans l'onglet "Formulaire".
• De copier directement les demandes dans la feuille "BDD" avec le code suivant :

Option Explicit
Sub AddNewTravels()
    Dim oWB As Workbook
    Dim oSheetFrom As Worksheet, oSheetTo As Worksheet
    Dim oRange As Range
    Dim lRowBDD As Long, lRow As Long, lCol As Long
    Dim sFileName As String

    'Recherche de la dernière ligne de la feuille BDD
    Set oSheetTo = ThisWorkbook.Worksheets("BDD")
    lRowBDD = oSheetTo.Cells(Rows.Count, 1).End(xlUp).Row

    'Récupération du nom du classeur de demandes de voyages
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel demandes", "*.xls*"
        .Show
        If .SelectedItems.Count > 0 Then
            sFileName = .SelectedItems(1)
        End If
    End With

    'Si un fichier a été récupéré, on le traite
    If Len(sFileName) > 0 Then
        Set oWB = Workbooks.Open(sFileName, False, True)
        Set oSheetFrom = oWB.Worksheets(1)
        'On cherche les dernières ligne et colonne à copier
        lRow = oSheetFrom.Cells(Rows.Count, 1).End(xlUp).Row
        lCol = oSheetFrom.Cells(1, Columns.Count).End(xlToLeft).Column
        'On affecte la plage de cellules à copier
        Set oRange = oSheetFrom.Range(oSheetFrom.Cells(2, 1), oSheetFrom.Cells(lRow, lCol))
        'On copie la plage dans la feuille BDD
        oRange.Copy oSheetTo.Cells(lRowBDD + 1, 1)
        'On fait le ménage
        oWB.Close
        Set oWB = Nothing
        Set oSheetFrom = Nothing
        Set oRange = Nothing
    End If

    Set oSheetTo = Nothing
End Sub

Je joins mes 2 classeurs de test.