Discussion :

[SamTokyo]

Bonjour, je souhaiterais réaliser un petit projet dans le cadre de mon école.

J'ai une feuille excel avec des dixaines de noms de serveurs (en A), de constructeurs x et y (en B) et deux types d'IP (en C et D). Je souhaiterais obtenir une liste des serveurs du contructeur x tout en les affichant d'une certaine manière sur une nouvelle feuille.

J'étudie VBA depuis peu et je n'ai réussi qu'à copier toutes les lignes où le constructeur x figure.
La méthode que j'imagine:
①Sélectionner les serveurs du constructeur x en B sur la feuille 1
②Copier leur nom en A et IP en D
③Les coller sur une nouvelle feuille excel (feuille: test) en suivant ce modèle:
#Memo1
nom du serveur1 (récuperer en A)
IP (récupérer en D)
#Memo2
nom du serveur2 (récuperer en A)
IP (récupérer en D)
#Memo3
...

Si quelqu'un peut m'aider j'en serais vraiment très reconnaissant.

Merci, Samuel

PS: la macro que j'ai utilisé jusqu'ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub SearchForString()
 
   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
 
   On Error GoTo Err_Execute
 
   'Commencer à chercher à partir le la deuxième ligne
   LSearchRow = 2
 
   'Copier les données dans la feuille Test à la deuxième ligne
   LCopyToRow = 2
 
   While Len(Range("A" & CStr(LSearchRow)).Value) > 0
 
      'Si les données dans la colonne B = "constructeurx", Copier la ligne vers feuil2
      If Range("B" & CStr(LSearchRow)).Value = "constructeurx" Then
 
         'Selectionner les lignes à copier dans la feuille Serveurs
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy
 
         'Coller ligne dans feuil2 à la ligne suivante
         Sheets("feuil2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
 
         'Bouger le compteur à la ligne suivante
         LCopyToRow = LCopyToRow + 1
 
         'Retour à feuil1 
         Sheets("feuil1").Select
 
      End If
 
      LSearchRow = LSearchRow + 1
 
   Wend
 
   'Selection cellule A3
   Application.CutCopyMode = False
   Range("A3").Select
 
   MsgBox "All matching data has been copied."
 
   Exit Sub
 
Err_Execute:
   MsgBox "Erreur"
 
End Sub

[OBO29]

Bonjour,

Quelque chose comme ça ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub SearchForString_v2()
    Dim Derniere_Ligne As Double, Ligne_actuelle As Double, Ligne_Copie As Double, Ligne As Double
    Dim Feuille_source As String, Feuille_Copie As String
    Dim LSearchRow As Integer, LCopyToRow As Integer
 
    'Gestion des erreurs à faire après les debuggages de base
 
    LSearchRow = 2
    Feuille_source = "feuil1"
 
    LCopyToRow = 2
    Feuille_Copie = "feuil2"
 
    Derniere_Ligne = Sheets(Feuille_source).UsedRange.SpecialCells(xlCellTypeLastCell).Row
 
    For Ligne = LSearchRow To Derniere_Ligne
        If Sheets(Feuille_source).Cells(Ligne, 2).Value = "constructeurx" Then
            Sheets(Feuille_source).Rows(Ligne).Copy Sheets(Feuille_Copie).Rows(LCopyToRow)
            LCopyToRow = LCopyToRow + 1
        End If
    Next Ligne
 
   Sheets(Feuille_source).Range("A3").Select
   MsgBox "All matching data has been copied."
End Sub