Microsoft 365 Macro pour importer les données d'un onglet à un autre

jps89

XLDnaute Nouveau
Bonjour,

Après pas mal de recherche, je ne trouve toujours pas le code de mes rêves :-(

Je m'explique: j'ai un fichier avec lequel je souhaite analyser les résultats de différents sondages (25 au total)

J'aimerai ajouter manuellement les données à la suite dans les feuilles (une par sondage) "sondage 1", "sondage 2" etc... en fonction de la source de mes données. Manuellement et donc jusqu'ici pas de problème.

Maintenant j'aimerai bien trouver un macro qui me permette d'ajouter les données des différentes feuilles (sondages 1,2, etc...) automatiquement dans la feuille "Base de donnée" , à la suite des données déjà présente et que la colonne A affiche le nom de la feuille de laquelle l'importation de la ligne a eu lieu.

Pouvez-vous m'aider? je vous joins un fichier avec des données "exemples".

A savoir que les noms "sondage 1, 2, etc..." vont être modifié en fonction du "vrai nom" du produit sondé.

MERCI d'avance pour votre aide :)
 

Pièces jointes

  • Survey Monkey analist test.xlsx
    932.7 KB · Affichages: 10

Hasco

XLDnaute Barbatruc
Bonjour,

Deux solutions :

Une par Power Query (fichier "PQ-.....") et une avec la macro ci-dessous

Pour la version Power query j'ai du nommer les plages de cellule de sondage (voir la petite macro 'CreerNomsSondage')

Placez vous sur la feuille PQ-Data puis cliquez sur 'Données/Actualiser tout'). J'ai vidé la table de résultat pour pouvoir joindre ici le fichier sans dépasser la limite.

Et enfin sachez que Power Query aller chercher vos données ailleurs que dans les feuilles de votre classeur (autre fichier excel, fichier texte, .csv, access, etc....)

VB:
Sub Collecter()
    Const FeuillesExclues As String = "Base de donnée;Résultats et annalyse;Données;" 'doit se terminer par un ';'
    Dim ws As Worksheet
    Dim plgSource As Range
    Dim NextRow As Long, NbRows As Long
    '
    ' figer les états et evènement ralentissant la chose
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    ' Parcourir toutes les feuilles
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, FeuillesExclues, ws.Name & ";") < 1 Then
            '
            ' définition de la plage de données de la feuille
            Set plgSource = ws.Range("A1").CurrentRegion
            '
            ' S'il n'y a pas au moins 3 lignes alors il n'y a pas de données
            If plgSource.Rows.Count > 2 Then
                '
                ' Enlever les deux lignes d'entête de la plage source
                Set plgSource = plgSource.Offset(2).Resize(plgSource.Rows.Count - 2)
                '
                ' Feuille Base de donnée
                With ThisWorkbook.Sheets("Base de donnée")
                    '
                    ' Calcul de la prochaine ligne disponible > 2
                    NextRow = Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row + 1)
                    '
                    ' Définition de la plage destination des données
                    ' ajustée au nombre de lignes/colonnes de la plage source
                    With .Cells(NextRow, 2).Resize(plgSource.Rows.Count, plgSource.Columns.Count)
                        '
                        .Value = plgSource.Value
                        '
                        ' décaler la plage d'une colonne à gauche pour y mettre le nom de la feuille
                        .Offset(, -1).Columns(1).Value = ws.Name
                    End With
                    '
                    ' Compter le nombre total de ligne
                    NbRows = NbRows + plgSource.Rows.Count
                End With
            End If
        End If
    Next
    '
    ' Rétablir les états et évènements de l'application
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    '
    ' Avertir l'utilisateur du nombre de lignes copiées.
    MsgBox NbRows & " lignes copiées dans la base de données", vbInformation, "Collecter les réponses"
End Sub
 

Pièces jointes

  • Survey Monkey analist test.xlsm
    903.9 KB · Affichages: 3
  • PQ-Survey Monkey analist test.xlsm
    970.1 KB · Affichages: 5
Dernière édition:

jps89

XLDnaute Nouveau
Bonjour,

Deux solutions :

Une par Power Query (fichier "PQ-.....") et une avec la macro ci-dessous

Pour la version Power query j'ai du nommer les plages de cellule de sondage (voir la petite macro 'CreerNomsSondage')

Placez vous sur la feuille PQ-Data puis cliquez sur 'Données/Actualiser tout'). J'ai vidé la table de résultat pour pouvoir joindre ici le fichier sans dépasser la limite.

Et enfin sachez que Power Query aller chercher vos données ailleurs que dans les feuilles de votre classeur (autre fichier excel, fichier texte, .csv, access, etc....)

VB:
Sub Collecter()
    Const FeuillesExclues As String = "Base de donnée;Résultats et annalyse;Données;" 'doit se terminer par un ';'
    Dim ws As Worksheet
    Dim plgSource As Range
    Dim NextRow As Long, NbRows As Long
    '
    ' figer les états et evènement ralentissant la chose
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    ' Parcourir toutes les feuilles
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, FeuillesExclues, ws.Name & ";") < 1 Then
            '
            ' définition de la plage de données de la feuille
            Set plgSource = ws.Range("A1").CurrentRegion
            '
            ' S'il n'y a pas au moins 3 lignes alors il n'y a pas de données
            If plgSource.Rows.Count > 2 Then
                '
                ' Enlever les deux lignes d'entête de la plage source
                Set plgSource = plgSource.Offset(2).Resize(plgSource.Rows.Count - 2)
                '
                ' Feuille Base de donnée
                With ThisWorkbook.Sheets("Base de donnée")
                    '
                    ' Calcul de la prochaine ligne disponible > 2
                    NextRow = Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row + 1)
                    '
                    ' Définition de la plage destination des données
                    ' ajustée au nombre de lignes/colonnes de la plage source
                    With .Cells(NextRow, 2).Resize(plgSource.Rows.Count, plgSource.Columns.Count)
                        '
                        .Value = plgSource.Value
                        '
                        ' décaler la plage d'une colonne à gauche pour y mettre le nom de la feuille
                        .Offset(, -1).Columns(1).Value = ws.Name
                    End With
                    '
                    ' Compter le nombre total de ligne
                    NbRows = NbRows + plgSource.Rows.Count
                End With
            End If
        End If
    Next
    '
    ' Rétablir les états et évènements de l'application
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    '
    ' Avertir l'utilisateur du nombre de lignes copiées.
    MsgBox NbRows & " lignes copiées dans la base de données", vbInformation, "Collecter les réponses"
End Sub
ça fonctionne! :) Merci beaucoup!
 

Discussions similaires

Statistiques des forums

Discussions
292 766
Messages
1 926 061
Membres
182 906
dernier inscrit
MM59