Macro transfert de donnée d'une feuille à un nombre de feuille inconnu

Macro transfert de donnée d'une feuille à un nombre de feuille inconnu - Matériels & problèmes divers - Hardware

Marsh Posté le 08-09-2015 à 19:38:34    

Bonjour à tous,  
 
Etant débutante en VBA depuis une semaine, et ayant été grandement aidé par ce forum, je viens vous poser une "petite" ("Grande" pour moi!) question.
 
Je collecte un nombre de données assez important pour plein d'individus.  
A chaque fois, j'ai une feuille nommée "FeuillesPropres" dans laquelle j'ai un tableau récapitulant les informations de chaque individus.  
Chaque individu porte un numéro spécifique (contenu dans la colonne F), et un nombre de lignes spécifiques.  
 
Ce que je voudrais faire, c'est qu'à partir de ce tableau, excel me crée une feuille par individu (dont le nom est le numéro de l'individu), et qu'il y colle la première ligne de la "FeuillesPropres" ainsi que toutes les lignes de ce sujet.  
Autrement dit, pour l'individu 1, ma macro doit créer une feuille "1", et coller toutes les lignes dont la colonne F de mon tableau est égal à 1.
 
Ce qu'il faut savoir, c'est que j'aimerai que cette macro puisse être réutilisée pour plein d'études différentes, c'est à dire pour un nombre d'individu inconnu et pour un nombre de lignes et de colonnes par individu inconnu.
 
Jusqu'à maintenant, j'ai réussi à faire en sorte qu'une feuille par individu soit créée mais je n'arrive pas du tout à lui demandé de me copier et coller les lignes correspondant à mon individu.
 
J'espère que ce message est claire ... et surtout que l'un d'entre vous réussira à mettre fin à mon supplice !!!!
Pardon par avance pour toutes les horreurs que vous trouverez dans cette macro reflétant mon niveau de VBA !
 
Merci par avance, je mets juste en dessous le code de ma macro !
 
 
 

Code :
  1. Sub TransfereFeuilleSujets()
  2. ' la macro doit transferer les résultats de chaque personne dans la feuille qui lui correspond
  3. 'Ne pas rafraichir l'écran pendant l'execution de la macro
  4.     Application.ScreenUpdating = False
  5. 'definition de la derniere ligne du tableau
  6. Dim DernLign As Long
  7. DernLign = Range("F" & Rows.Count).End(xlUp).Row + 50
  8. 'Recuperation du nbr de sujets   
  9.     Range("C2" ).Select
  10.     ActiveCell.FormulaR1C1 = "=COUNT(C[-1])"
  11.    
  12. 'Report du num de sujet dans la colonne B      
  13.         Range("B2" ).Select
  14.     ActiveCell.FormulaR1C1 = "=IF(RC[4]=R[-1]C[4],"""",IF(RC[4]="""","""",RC[4]))"
  15.         Range("B2" ).Select
  16.     Selection.AutoFill Destination:=Range("B2:B3000" ), Type:=xlFillDefault
  17.         Range("B2:B3000" ).Select
  18.     ActiveWindow.SmallScroll Down:=DernLign
  19.    
  20. 'Copier / coller des valeurs de la colonne B dans A pour qu'il ne detecte que des cellules vides et non pas des cellules avec formules lors de l'étape précédente
  21.        Range("B2:B" & DernLign).Select
  22.     Selection.Copy
  23.        Worksheets("FeuillesPropres" ).Range("A2:A" & DernLign).Select
  24.     Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
  25.         False, Transpose:=False
  26. '' ==> La macro fonctionne bien jusqu'ici!!
  27. 'Creation de feuilles correspondant à chaque personne selon son numéro
  28. Dim Plage_sujets As Range
  29. Dim nom, C
  30. Set Plage_sujets = Range(Cells(3, 1), Cells(DernLign, 1))
  31. Dim nom_sujet As Range
  32. Dim nomSujet, NS
  33. Set Plage_numlignesujet = Range(Cells(3, 6), Cells(DernLign, 6)) 'Activer la colonne F de la feuille "FeuillesPropres" (Est ce que c'est bien ça??)
  34. For Each C In Plage_sujets
  35.     If C.Value <> "" Then
  36.         For Each NS In Plage_numlignesujet
  37.                 If C.Value = NS.Value Then
  38.                     Rows(ActiveCell.Row).Copy 'Copier toutes les lignes dont la valeur correspondant au numéro de personne est retrouvé dans la colonne F
  39.                     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count) 'Création d'une feuille par num de personne
  40.                     ActiveSheet.Name = C.Value 'donne à la feuille le nom du sujet
  41.                     Range("F3" ).Select 'Selectionne F3 de la feuille créée pour l'individu
  42.                     ActiveCell.Paste 'Coller les valeurs des lignes copiées pour chaque personne
  43.                 End If
  44.         Next NS
  45.     End If
  46. Next C
  47.        
  48. '==> la partie d'après fonctionne bien aussi
  49. 'copier coller de la première ligne dans chaque nouvelle feuille
  50.     Dim F As Variant
  51.     a = Application.Sheets.Count ' compte le nombre de feuille
  52.    
  53.     For F = 1 To a
  54.     If Sheets(F).Name <> "FeuillesPropres" Then
  55.     Sheets("FeuillesPropres" ).Rows(1).Copy Sheets(F).Rows(1)
  56.     End If
  57. Next
  58. End Sub


---------------
Annye
Reply

Marsh Posté le 08-09-2015 à 19:38:34   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed