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
  6. 'Ne pas rafraichir l'écran pendant l'execution de la macro
  7.     Application.ScreenUpdating = False
  9. 'definition de la derniere ligne du tableau
  10. Dim DernLign As Long
  11. DernLign = Range("F" & Rows.Count).End(xlUp).Row + 50
  13. 'Recuperation du nbr de sujets   
  14.     Range("C2" ).Select
  15.     ActiveCell.FormulaR1C1 = "=COUNT(C[-1])"
  16.    
  17. 'Report du num de sujet dans la colonne B      
  18.         Range("B2" ).Select
  19.     ActiveCell.FormulaR1C1 = "=IF(RC[4]=R[-1]C[4],"""",IF(RC[4]="""","""",RC[4]))"
  20.         Range("B2" ).Select
  21.     Selection.AutoFill Destination:=Range("B2:B3000" ), Type:=xlFillDefault
  22.         Range("B2:B3000" ).Select
  23.     ActiveWindow.SmallScroll Down:=DernLign
  24.    
  26. '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
  27.        Range("B2:B" & DernLign).Select
  28.     Selection.Copy
  29.        Worksheets("FeuillesPropres" ).Range("A2:A" & DernLign).Select
  30.     Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
  31.         False, Transpose:=False
  36. '' ==> La macro fonctionne bien jusqu'ici!!
  40. 'Creation de feuilles correspondant à chaque personne selon son numéro
  41. Dim Plage_sujets As Range
  42. Dim nom, C
  43. Set Plage_sujets = Range(Cells(3, 1), Cells(DernLign, 1))
  45. Dim nom_sujet As Range
  46. Dim nomSujet, NS
  47. 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??)
  49. For Each C In Plage_sujets
  50.     If C.Value <> "" Then
  51.         For Each NS In Plage_numlignesujet
  52.                 If C.Value = NS.Value Then
  53.                     Rows(ActiveCell.Row).Copy 'Copier toutes les lignes dont la valeur correspondant au numéro de personne est retrouvé dans la colonne F
  54.                     Sheets.Add Count:=1, after:=Worksheets(Worksheets.Count) 'Création d'une feuille par num de personne
  55.                     ActiveSheet.Name = C.Value 'donne à la feuille le nom du sujet
  56.                     Range("F3" ).Select 'Selectionne F3 de la feuille créée pour l'individu
  57.                     ActiveCell.Paste 'Coller les valeurs des lignes copiées pour chaque personne
  58.                 End If
  59.         Next NS
  60.     End If
  61. Next C
  62.        
  64. '==> la partie d'après fonctionne bien aussi
  68. 'copier coller de la première ligne dans chaque nouvelle feuille
  69.     Dim F As Variant
  70.     a = Application.Sheets.Count ' compte le nombre de feuille
  71.    
  72.     For F = 1 To a
  73.     If Sheets(F).Name <> "FeuillesPropres" Then
  74.     Sheets("FeuillesPropres" ).Rows(1).Copy Sheets(F).Rows(1)
  75.     End If
  77. Next
  79. 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