Bonjour à tous,
Voici mon problème qui n'en n'est pas réellement un en fait
J'ai puisé dans différentes sources et je suis parvenu à faire une macro me sélectionnant les données que je souhaite dans une feuille Excel et à me les recopier dans une feuille temporaire pour les sauver au format .CSV.
Etant débutant, pourriez-vous m'indiquer s'il y a un moyen d'optimiser le code afin de réduire le temps de réalisation de la macro? Elle fait toujours la même boucle mais pour des valeurs différentes et je n'arrive pas à visualiser comment définir une boucle sur les valeurs.
Je n'ai mis qu'une partie du très long code mais les lignes qui suivaient étaient répétitives et uniquement les valeurs changeaient.
Ardamire
Voici mon problème qui n'en n'est pas réellement un en fait
J'ai puisé dans différentes sources et je suis parvenu à faire une macro me sélectionnant les données que je souhaite dans une feuille Excel et à me les recopier dans une feuille temporaire pour les sauver au format .CSV.
Etant débutant, pourriez-vous m'indiquer s'il y a un moyen d'optimiser le code afin de réduire le temps de réalisation de la macro? Elle fait toujours la même boucle mais pour des valeurs différentes et je n'arrive pas à visualiser comment définir une boucle sur les valeurs.
Je n'ai mis qu'une partie du très long code mais les lignes qui suivaient étaient répétitives et uniquement les valeurs changeaient.
Merci pour votre aide et bonne après-midi.Code:Sub Filter() Application.ScreenUpdating = False Dim Lig As Long Dim Col As String Dim NbrLig As Long Dim NumLig As Long Sheets("TEMP").Activate ' feuille de destination Cells.Clear Col = "B" ' colonne de la donnée non vide à tester NumLig = 0 With Sheets("Import_Sheet") ' feuille source NbrLig = .Cells(65536, Col).End(xlUp).Row For Lig = 1 To NbrLig If .Cells(Lig, Col).Value = "Label 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "Unit 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "250" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next End With ActiveSheet.SaveAs Filename:= _ "C:\250_Unit 1.csv", FileFormat:=xlCSV, CreateBackup:=False Sheets("250_Unit 1").Activate ' feuille de destination Cells.Clear Col = "B" ' colonne de la donnée non vide à tester NumLig = 0 With Sheets("Import_Sheet") ' feuille source NbrLig = .Cells(65536, Col).End(xlUp).Row For Lig = 1 To NbrLig If .Cells(Lig, Col).Value = "Label 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "Unit 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "300" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next End With ActiveSheet.SaveAs Filename:= _ "C:\300_Unit 1.csv", FileFormat:=xlCSV, CreateBackup:=False Sheets("300_Unit 1").Activate ' feuille de destination Cells.Clear Col = "B" ' colonne de la donnée non vide à tester NumLig = 0 With Sheets("Import_Sheet") ' feuille source NbrLig = .Cells(65536, Col).End(xlUp).Row For Lig = 1 To NbrLig If .Cells(Lig, Col).Value = "Label 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "Unit 1" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If If .Cells(Lig, Col).Value = "400" Then .Cells(Lig, Col).EntireRow.Copy NumLig = NumLig + 1 Cells(NumLig, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next End With ActiveSheet.SaveAs Filename:= _ "C:\400_Unit 1.csv", FileFormat:=xlCSV, CreateBackup:=False Application.ScreenUpdating = True End Sub
Ardamire
Dernière édition: