Regroupement de donnees provenant de plusieurs feuilles excel

[pierrot13]

Bonjour a tous !

Avant tout, une petite presentation s`impose (etant tout nouveau sur ce forum !), je m appelle Pierre et je suis actuellement en stage en Suede (stage de fin d etude).

J ai decide de solliciter vos competences, afin d`avoir de l aide concernant la mise en place d un code VB (etant debutant, j ai tres peu de notions en VB ...).

Resume du probleme:

Au sein d´un fichier excel, je souhaite regrouper des donnees venant de plusieurs pages, dans 1 page "base clientele" (recuperation des donnees avec activation et/ou mis a jours de la liste depuis un bouton module par exemple...)

- Les donnees viennent de 10 pages (Quiz 1, ....,Quiz 10) faisant chaqun 2000 lignes, et qui sont mis a jours regulierement...

- De plus, cette page "base clientele" recevra les informations provenant des colonnes "agreement"; "last name" ; "firstname" ; "birthday"; "email"; "city"; "Q1"; "Q2"; "Q3"; "Assign a date" de ces differents Quiz.

J ai deja commencer a reflechir a un code mais mes notions VB sont tres limitees, ce qui explique pourquoi je sollicite votre aide ...

En piece jointe, voici mon fichier excel.

J espere avoir ete assez clair, et pour toute question, n hesitez pas !

Merci d avance pour votre aide

Cordialement,

Pierre

 

[pierrot13]

Re : Regroupement de donnees provenant de plusieurs feuilles excel

Concernant le fichier joint, je vais le mettre sous Cijoint ( il depasse la capacite maximale, meme en .zip )

 

[pierrot13]

Re : Regroupement de donnees provenant de plusieurs feuilles excel

voici le lien !

Cijoint.fr - Service gratuit de dépôt de fichiers

Merci d avance !

 

[PMO2]

Re : Regroupement de donnees provenant de plusieurs feuilles excel

Bonjour,

Essayez avec le code suivant à copier dans un module Standard

Sub Regroupement_pmo()
Dim S As Worksheet
Dim R As Range
Dim var
Dim h&
Dim i&
Dim cpt&
Dim T()
Dim A$
On Error GoTo Erreur
Application.ScreenUpdating = False
For h& = 1 To 10
  A$ = "Quiz " & h&
  Set S = Sheets(A$)
  Set R = S.[w1].CurrentRegion
  var = R
  For i& = 2 To UBound(var, 1)
    If LCase(var(i&, 23)) = "yes" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 11, 1 To cpt&)
      T(1, cpt&) = A$
      T(2, cpt&) = i&
      T(3, cpt&) = var(i&, 11)
      T(4, cpt&) = var(i&, 10)
      T(5, cpt&) = var(i&, 12)
      T(6, cpt&) = var(i&, 13)
      T(7, cpt&) = var(i&, 17)
      T(8, cpt&) = var(i&, 19)
      T(9, cpt&) = var(i&, 20)
      T(10, cpt&) = var(i&, 21)
      T(11, cpt&) = CLng(CDate(var(i&, 22)))
    End If
  Next i&
Next h&
A$ = "Base"
Set S = Sheets(A$)
S.Activate
S.Cells.Delete
Set R = S.Range(S.Cells(2, 1), Cells(UBound(T, 2) + 1, UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
var = Array("Quiz", "Row", "Last Name", "First Name", "Birthday", "Email", "City", "Q1", "Q2", "Q3", "Assign a date")
Set R = S.Range(S.Cells(1, 1), S.Cells(1, UBound(var) + 1))
R = var
R.Interior.ColorIndex = 37
R.HorizontalAlignment = xlCenter
R.Font.Bold = True
With ActiveWindow
  .SplitRow = 1
  .FreezePanes = True
End With
S.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
Exit Sub
Erreur:
If Err = 9 Then
  MsgBox "The WorkSheet ''" & A$ & "'' cannot be found"
Else
  MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End If
Application.ScreenUpdating = True
End Sub

CONDITIONS IMPERATIVES
Le classeur doit comporter une feuille "Base" et 10 feuilles "Quiz 1" à "Quiz 10". Ces 10 feuilles doivent avoir la même structure que celles de votre exemple.

Le regroupement va s'inscrire dans la feuille "Base" qui sera systématiquement effacée chaque fois que la Sub Regroupement_pmo sera lancée.
J'ai ajouté, en plus de ce que vous demandiez, 2 colonnes en A et B. Une renseignée du nom de la feuille Quiz et la suivante du numéro de ligne des données valides.
Je ne joins pas de classeur car beaucoup trop gros.

Cordialement.

PMO
Patrick Morange

 

[pierrot13]

Re : Regroupement de donnees provenant de plusieurs feuilles excel

Salut Patrick !

juste un mot ... MERCI !

Tu viens de me rendre un grand service, ton code est parfaitement compréhensible et d une logique implacable !

On rajoute à cela la gentillesse, le dévouement et la rapidité de ta réponse ( c est vraiment impressionnant et cela me permet aussi d en apprendre beaucoup de vos codes tout comme d autres spécialistes du VB ! )

Je vais plancher sur ce que tu m as apporter ( c est vraiment beaucoup ! ), et peut être penser à de nouvelles améliorations pour la suite !

Encore merci pour tous et au plaisir de pouvoir entrer de nouveau en contact avec toi !

Cordialement,

Pierre