Bonjour,
Un peu novice en VBA j'ai fait ce code mais ca allourdi énormément mon fichier et je voulais savoir si vous auriez une solution pour qu'il prenne moins de place ? Peut être j'ai pensé: faire exécuter le code que sur les lignes qui sont remplies mais je ne sais pas comment faire.
Le code: j'extrait une base de donnée (nom de l'entreprise avec les produits qu'elle fait et leurs caractéristique) et j'aimerai qu'en fonction du nom de l'entreprise ca se copie colle dans le feuille de l'entreprise. J'ai testé une solution avec Power query mais pareil le fichier était beaucoup trop lourd voilà pourquoi je me suis rabattue sur du vba.
Merci beaucoup pour votre aide !!
Sub Macro4()
' Macro4 Macro
' Decache Colonne
Sheets("Extract").Select
Cells.EntireColumn.Hidden = False
'Entreprise A
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise A"
Columns("A:Q").Select
Selection.Copy
Sheets("A").Select
Range("A1").Select
ActiveSheet.Paste
'Entreprise B
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise B"
Columns("A:Q").Select
Selection.Copy
Sheets("B").Select
Range("A1").Select
ActiveSheet.Paste
'Entreprise C
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise C"
Columns("A:Q").Select
Selection.Copy
Sheets("C").Select
Range("A1").Select
ActiveSheet.Paste
'Entreprise D
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise D"
Columns("A:Q").Select
Selection.Copy
Sheets("D").Select
Range("A1").Select
ActiveSheet.Paste
'Entreprise E
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise E"
Columns("A:Q").Select
Selection.Copy
Sheets("E").Select
Range("A1").Select
ActiveSheet.Paste
'Entreprise F
Sheets("Extract").Select
ActiveSheet.Range("$A$1:$Q$77").AutoFilter Field:=5, Criteria1:="Entreprise F"
Columns("A:Q").Select
Selection.Copy
Sheets("F").Select
Range("A1").Select
ActiveSheet.Paste
'nofilter()
On Error Resume Next
Sheets("Extract").ShowAllData
Sheets("TCD").Select 'pour revenir automatiquement sur feuille TCD
End Sub