Recherche + Copie de ligne

Recherche + Copie de ligne - VB/VBA/VBS - Programmation

Marsh Posté le 18-07-2017 à 15:13:42    

Bonjour,
 
Je suis en train de construire des macros pour extraire des données d'un fichier Excel très lourd (25Mo) pour les filtrer et calculer des moyennes glissante et faire des graphiques au final  :pt1cable: mais avant d'en arriver là... :sweat:  
 
Déjà je ne connais pas le VBA  :lol: Néanmoins, j'ai réussi à faire pas mal de petite chose. Par contre, je suis un peu bloqué.
 
Je cherche à faire une macro qui séparer les lignes en fonction des noms de la colonne A. Je m'explique.
 
J'ai une centaine de colonne avec un calendrier et plus de 2500 lignes + des titres de colonne de la ligne 1 à 4.
 
Je souhaites donc que la macro :
1/ regarde les noms qui sont dans la colonne A de la ligne 5 à 3000.
2/ sélection toutes les lignes avec le même nom puis les copies dans une nouvelle feuille. (qu'elle le fasse pour tous les différents noms, s'il y a 10noms je veux qu'il y ait 10 feuilles.
 
Attention un des problèmes c'est que je ne connais pas tous les noms de la colonne A et qu'ils sont nombreux. Donc il faut que la macro se débrouille.
 

Reply

Marsh Posté le 18-07-2017 à 15:13:42   

Reply

Marsh Posté le 27-07-2017 à 00:03:16    

Ca devrait fonctionner
Attention a bien exécuter à partir de la feuille de base, parce que comme tu as pas mis son nom j'ai du récuperer celui de la feuille active.
Peut etre long en fonction du nombre de ligne...
J'ai pas désactivé les calculs, donc s'il y en a ça peut être encore plus long.
 

Code :
  1. Sub CopieLigne()
  3. Dim NbVal As Integer
  4. Dim I As Integer
  5. Dim Nom As String
  6. Dim feuille As String
  7. Dim fintab As String
  9. 'determine la feuille où est jouée la macro
  10. feuille = ActiveSheet.Name
  11. 'determine le nombre de ligne à vérifier
  12. NbVal = Application.WorksheetFunction.CountA(Worksheets(feuille).Range("$A:$A" ))
  14. 'Boucle sur chaque ligne
  15. For I = 2 To NbVal
  16.     'stock le contenu de la cellule pour tester sa présence en feuille
  17.     Nom = Sheets(feuille).Cells(I, 1)
  18.     'vérifie si la feuille existe, si oui copie la ligne en bas du tableau existant, si non créé un nouveau tableau avec la ligne à copier
  19.     If WsExist(Nom) = False Then
  20.         Sheets.Add
  21.         ActiveSheet.Name = Nom
  22.         Sheets(feuille).Range("1:1" ).Copy Sheets(Nom).Range("A1" )
  23.         Sheets(feuille).Range(I & ":" & I).Copy Sheets(Nom).Range("A2" )
  24.     Else
  25.         fintab = Sheets(Nom).Range("A" & Rows.Count).End(xlUp).Row + 1
  26.         Sheets(feuille).Range(I & ":" & I).Copy Sheets(Nom).Range("A" & fintab)
  27.     End If
  28. Next I
  30. MsgBox ("Terminé" )
  32. End Sub
  34. Function WsExist(Nom$) As Boolean
  35. On Error Resume Next
  36. WsExist = Sheets(Nom).Index
  37. End Function


Message édité par wago le 27-07-2017 à 00:04:57
Reply

Marsh Posté le 30-07-2017 à 19:52:40    

Merci je vais regarder ça.

Reply

Sujets relatifs:

Leave a Replay

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