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é.
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
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