Excel - Une macro pour créer un nouveau classeur et copier des données

Problème

Je recherche une macro pour copier des lignes en fonction du contenu partiel d'une cellule dans une colonne. J'ai une feuille de calcul Excel appelée "arc.xlsx" à partir de laquelle j'aimerais copier des données vers d'autres nouveaux fichiers Excel lorsque certains critères sont remplis. Le fichier Excel contenant le fichier est C: \ Documents and Settings \ xxxx \ Desktop \ Company. Suis seulement un débutant dans Excel.

Ci-dessous un exemple de arc.xlsx

 GP BR CUST_NO CUST_NAME jour de l'année I1 01 999999 SMITH 00 08 09 I1 ab 999999 SMITH 04 08 09 I1 cd 999999 SMITH 04 10 09 I1 01 999999 SMITH 04 01 10 I1 02 999999 SMITH 27 02 10 I1 01 999999 SMITH cd 999999 SMITH 02 03 10 I1 cd 999999 SMITH 04 03 10 I1 cd 999999 SMITH 30 07 09 I1 ab 999999 SMITH 30 07 09 I1 02 999999 SMITH 30 07 09 

• Je voudrais que la macro copie les lignes qui ont un "ab" dans la colonne B (avec le titre BR) et les enregistre dans un nouveau fichier Excel avec le nom ab.xlsx dans le même dossier d’emplacement.
• Et de même pour 'cd', '01' et '02' en enregistrant les données dans des fichiers nommés cd.xlsx, 01.xlsx, etc.

Solution

1. FAITES UNE SAUVEGARDE DE VOTRE MANUEL

2. Ouvrez le classeur

3. Appuyez sur ALT + F11 (les touches ALT et F11 simultanément). Ce VBE ouvert

4. Dans le menu de VBE, cliquez sur Insérer, puis sélectionnez Module en cliquant dessus. Cela ouvrira un module vierge

5. Copiez le code donné après les instructions en sélectionnant le code (qui sera trouvé après les instructions) et en appuyant sur CTRL + C (les deux touches en même temps).

6. Collez le code dans le module nouvellement ajouté (voir l'étape 4) en cliquant sur le module et en appuyant sur CTRL + V (à nouveau simultanément).

7. Assurez-vous qu'il n'y a pas de ligne rouge dans le code collé.

8. Appuyez sur F5 pour exécuter la macro.

9 Vérifiez les documents à l'emplacement par défaut où Excel enregistre généralement le fichier.

VOICI LE CODE

 Sub details () Dim thisWB As String Dim newWB As String thisWB = ActiveWorkbook.Name En cas d'erreur Reprendre les feuilles suivantes ("tempsheet"). Supprimer après erreur Aller à 0 Feuilles.Activer ActiveSheet.Name = "feuille temps" ("Feuille1"). Sélectionnez If ActiveSheet.AutoFilterMode Then Cells.Select On Error Reprendre Next ActiveSheet.ShowAllData On Error Aller à 0 Fin si Colonnes ("B: B"). Sélectionnez Selection.Copy Sheets ("tempsheet"). Sélectionnez Range ("A1"). Sélectionnez ActiveSheet.Paste Application.CutCopyMode = False If (Cells (1, 1) = ""), puis lastrow = Cells (1, 1) .End (xlDown) .Row If lastrow Rows.Count Then Range ("A1: A" & lastrow - 1) .Sélectionnez Selection.Delete Shift: = xlUp Fin si Fin si colonnes ("A: A"). Sélection de colonnes ("A: A"). Action AdvancedFilter: = xlFilterCopy, _ CopyToRange: = Range (" B1 "), Unique: = True Columns (" A: A "). Supprimer Cells.Select Selection.Sort _ Key1: = Range (" A2 "), Order1: = xlAscending, _ En-tête: = xlYes, OrderCustom: = 1, _ MatchCase: = False, Orientation: = xlTopToBottom, _ DataOption1: = xlSortNormal lMaxSupp = Cells (Rows.Count, 1) .End (xlUp) .Row pour s uppno = 2 Pour lMaxSupp Windows (thisWB) .Activate supName = Sheets ("tempsheet"). Range ("A" & suppno) Si supName "" Ensuite, Workbooks.Add ActiveWorkbook.SaveAs supName newWB = ActiveWorkbook.Name Windows (thisWB). Activer les feuilles ("Sheet1"). Sélectionnez Cells.Select si ActiveSheet.AutoFilterMode = False Puis Selection.AutoFilter End If Selection.AutoFilter Field: = 2, Criteria1: = "=" & supName, _ Opérateur: = xlAnd, Criteria2: = "" lastrow = Cells (Rows.Count, 2) .End (xlUp) .Row Rows ("1:" & lastrow) .Copie Windows (newWB) .Activer ActiveSheet.Paste ActiveWorkbook.Save ActiveWorkbook.Close End Si Next Sheets ( Supprimer les feuilles ("Sheet1"). Sélectionnez If ActiveSheet.AutoFilterMode Then Cells.Select ActiveSheet.ShowAllData End If End Sub 

Merci à Rizvisa1 pour ce conseil.