Copier des lignes d'une feuille vers une autre

Bonjour à tous,

J'ai besoin de votre aide. En effet, je suis confronté au problème suivant :

J'ai une feuille contenant plusieurs colonnes et je souhaite trier les lignes de ce tableau.

Voici la procédure qui devrait être effectuée :

Recherche un numéro dans la colonne A (numéro unique, qui n’apparaît que dans une seule ligne, disons 505), copier la ligne correspondante et la coller en première ligne d'une autre feuille.

Ensuite chercher un autre numéro, disons 976970, copier la ligne correspondante et la coller dans l'autre feuille en deuxième ligne, etc.

J'aimerai aussi savoir quel code utiliser pour sauter une ligne dans la feuille dans laquelle les lignes sont collées ?

J’adapterai ce code pour mon utilisation finale !

Merci infiniment à ceux qui pourront m'aider !

J'ai trouvé ceci qui fonctionne

Sub SearchForString1()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 4
   LSearchRow = 1

   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 1

   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("A" & CStr(LSearchRow)).Value = "505" Then

         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

Sub SearchForString2()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 4
   LSearchRow = 1

   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 1

   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("A" & CStr(LSearchRow)).Value = "976970" Then

         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Move counter to next row
         LCopyToRow = LCopyToRow + 2

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

Je crée ensuite un macro pour appeler tous les macros l'un après l'autre.

Je suis quand même toujours confronté à un problème.

Si par la suite je souhaite ajouter des recherches et faire en sorte qu'elle se copie en position 3 sur la feuille 2, je devrai mettre à jour tous les macros suivants en leur ajoutant un +1 après LCopyToRow + 2 pour que ça fonctionne.

Quelqu'un aurait-il une solution pour que ce macro soit plus adaptable en cas d'ajout ou de suppression d'élément ?

Merci d'avance

Rechercher des sujets similaires à "copier lignes feuille"