Insertion nouvelle feuille

Bonjour j'ai un code qui me permet d'insérer une nouvelle feuille dans un classeur et de copier les données ciblées sur cette nouvelle feuille.

Cependant le code mets un peu de temps à tourner, auriez vous une amélioration sur ce dernier.

Merci !!

Sub macro ()

'Déclaration des variables

Dim N_Row As Long

Dim i_Loop As Long

Dim Counter As Long

Dim Row As Long

'insertion nouvelle feuille

With Sheets.Add

.Name = "sheet2"

.Tab.Color = 1

End With

'Sélection de la feuille 1

Sheets("sheet1").Select

'Récupérer dans une variable (N_Row) la ligne de la dernière cellule non vide

N_Row = Cells(1, 1).End(xlDown).Row

Counter = 0

'Chiffre 2 pour la variable "Row"

Row = 2

'Boucle

For i_Loop = 2 To N_Row

If Cells(i_Loop, 2) = "Italie" Then

Rows(i_Loop).Copy

Worksheets("sheet2").Select

Rows(Row).Select

ActiveSheet.Paste

Row = Row + 1

Worksheets("sheet1").Select

End If

Next i_Loop

Sheets("sheet1").Select

Rows(1).Copy

Worksheets("sheet2").Select

Rows(1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

Bonjour, cet autre code me permet de cibler et copier des valeurs d'une feuille et coller les lignes entières sur une autre feuille.

Idem que l'autre macro : celui ci met un peu de temps à s'exécuter.

Si quelqu'un pourrait me donner un coup de main.

Merci.

Sub macro ()

Dim N_Row As Long

Dim i_Loop As Long

Dim i As String

Dim Counter As Long

Dim Row As Long

Sheets("sheet1").Select

'la dernière cellule non vide

N_Row = Range("A1").End(xlDown).Row

Row = 2

'Boucle

For i_Loop = 2 To N_Row.

i = Cells(i_Loop, 6)

'Condition si la variable ISIN est égale aux trois ISIN à identifier

If ISIN = "excel" Or ISIN = "vba" Or ISIN = "python" Then

'Copie de la ligne i_Loop

Rows(i_Loop).Copy

Sheets("sheet2").Select

Cells(Row, 1).Select

ActiveSheet.Paste

Sheets("sheet1").Select

Row = Row + 1

Else

End If

Next i_Loop

Sheets("sheet2").Select

Rows(1).Copy

Worksheets("ID_FOCUS").Select

Rows(1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

Bonjour,

J'ai juste supprimé les Select ça devrait suffire, toutefois si tu as plusieurs (dizaines de) milliers de lignes, ont peut encore améliorer la rapidité : Dans ce cas le préciser.

Sub macro()
'Déclaration des variables :
'Sous cette forme ça veut dire la même chose
'mais en plus on peut voir toute la Sub sans scroller...
Dim N_Row&, i_Loop&, Counter&, Row&
'insertion nouvelle feuille
With Sheets.Add
   .Name = "sheet2"
   .Tab.Color = 1
End With
'Sélection de la feuille 1 (on ne sélect JAMAIS ça sert juste à faire perdre du temps...)
With Sheets("sheet")
   'Récupérer dans une variable (N_Row) la ligne de la dernière cellule non vide
   N_Row = .Cells(1, 1).End(xlDown).Row
   Counter = 0
   'Chiffre 2 pour la variable "Row"
   Row = 2
   'Boucle
   For i_Loop = 2 To N_Row
      If .Cells(i_Loop, 2) = "Italie" Then
         .Rows(i_Loop).Copy Worksheets("sheet2").Cells(Row, 1)
         Row = Row + 1
      End If
   Next i_Loop
   .Rows(1).Copy Worksheets("sheet2").Cells(1, 1)
End With
End Sub

Merci d'utiliser la balise </> quand tu cites du code dans ton fil. (Sélectionner tout le code puis appuyer sur le bouton </>)

A+