Discussion :

[mederick]

Bonjour,

Je cherche svp de l'aide sur une macro qui ne fonctionne pas comme prévu:

je souhaite copier dans un classeur excel (où se trouve ma macro que je lance) les onglets de plusieurs classeurs qui ont un nom différent (je parle des onglets) de "synthèse", "Portfolio - Detailed Info", "Sheet1", "Sheet2", "Data", "tcd".

ainsi je commence par supprimer dans le classeur ù se trouve ma macro tous les onglets différents de "synthèse".
Puis je défini les endroits où sont mes ficheirs, les onglets des classeurs que je veux copier.
Je fais ensuite un tri par ordre alphabétique.


Ma macro ne copie pas tous mes onglets et copie en doublons certains autres onglets. Pouvez-vous svp m'aider? Je souhaiterais également rajouter une fonction pour que l'onglet "Synthèse" reste le premier onglet.

Pouvez-vous svp m'aider?



Vous trouverez ci-dessous le contenu de ma macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub importDonnées()
 
Dim w As Worksheet
Application.DisplayAlerts = False
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "Synthèse" Then
     w.Delete 'suppression de toutes les feuilles excel préalablement importées
End If
Next
Application.DisplayAlerts = True
 
Dim wkA As Workbook, wkB As Workbook, wkC As Workbook, wkD As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Dim wb As Worksheet, wc As Worksheet, wd As Worksheet
Application.ScreenUpdating = False
 
Set wkA = ThisWorkbook ' le dossier qui contient le code et qui va recevoir les données
 
chemin = "F:\CORI-ENE\Mgt-Reporting\Profitability\2017\Actuals\Dépot Wkb COS\" ' adresse du dossier source
fichier = "Synthèse Médérick.xlsx" ' nom du dossier source
Workbooks.Open chemin & fichier
Set wkB = ActiveWorkbook
For Each wb In ThisWorkbook.Worksheets
    If wb.Name <> "Portfolio - Detailed Info" And wb.Name <> "Sheet1" And wb.Name <> "Sheet2" And wb.Name <> "Data" And wb.Name <> "tcd" Then
wb.Copy After:=wkA.Sheets("Synthèse") 'l'onglet à copier nommée et le placement dans le dossier qui recevra les données après l'onglet Synthèse
 
End If
Next
wkB.Close True 'fermer le dossier source
 
chemin = "F:\CORI-ENE\Mgt-Reporting\Profitability\2017\Actuals\Dépot Wkb COS\" ' adresse du dossier source
fichier = "Synthèse Antonio.xlsx" ' nom du dossier source
Workbooks.Open chemin & fichier
Set wkC = ActiveWorkbook
For Each wc In ThisWorkbook.Worksheets
    If wc.Name <> "Portfolio - Detailed Info" And wc.Name <> "Sheet1" And wc.Name <> "Sheet2" And wc.Name <> "Data" And wc.Name <> "tcd" Then
wc.Copy After:=wkA.Sheets("Synthèse") 'les onglets à copier et le placement dans le dossier qui recevra les données après l'onglet Synthèse
 
End If
Next
wkC.Close True 'fermer le dossier source
 
chemin = "F:\CORI-ENE\Mgt-Reporting\Profitability\2017\Actuals\Dépot Wkb COS\" ' adresse du dossier source
fichier = "Synthèse Alexandre.xlsx" ' nom du dossier source
Workbooks.Open chemin & fichier
Set wkD = ActiveWorkbook
For Each wd In ThisWorkbook.Worksheets
    If wd.Name <> "Portfolio - Detailed Info" And wd.Name <> "Sheet1" And wd.Name <> "Sheet2" And wd.Name <> "Data" And wd.Name <> "tcd" Then
wkD.Sheets.Copy After:=wkA.Sheets("Synthèse") 'les onglets à copier et le placement dans le dossier qui recevra les données après l'onglet Synthèse
 
End If
Next
wkD.Close True 'fermer le dossier source
 
 
For n = 1 To Sheets.Count
For o = i + 1 To Sheets.Count
If UCase(Sheets(n).Name) > UCase(Sheets(o).Name) Then Sheets(o).Move before:=Sheets(n)
Next o
Next n
 
 Application.ScreenUpdating = True
End Sub

[Invité]

Bonjour,

Une solution possible dans le fichier joint.

[mederick]

Merci beaucoup pour ton aide, j'ai juste un dernier problème c'est que ca ajoute "les listes de repères (lettres A à C) dans ce cas pour différencier le classeur duquel vient l'extraction. Or dans mon cas je ne souhaite pas avoir cette lettre placée avant le nom de mon onglet.

Je souhaite juste avoir l'onglet extrait avec son nom d'origine puis le rangement par ordre alphabétique des onglets du classeur créé.

En retirant les références à ces listes des repères la macro ne fonctionne plus. Comment pourrait on retirer cette donnée. Tout le reste est parfait sinon.

Merci encore pour ton aide.

[Invité]

.

Bonjour,

Il te faut enlever les variables LettreRepere composant le nom provisoire de l'onglet à rapatrier dans cette procédure. Le risque est d'avoir des homonymies dans le nom des onglets rapatriés.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
 
Sub ImportDesOnglets(ByVal FichierCible2 As Workbook, ByVal CheminNom As String, ByVal ListeDesOngletsAEcarter2 As Variant, ByVal LettreRepere As String)
 
Dim FichierSource As Workbook
Dim ShSource As Worksheet
Dim OngletACopier As Boolean
Dim I As Integer
Dim NomInitial As String
 
    Set FichierSource = Workbooks.Open(CheminNom)
    For Each ShSource In FichierSource.Worksheets
        OngletACopier = True
        For I = LBound(ListeDesOngletsAEcarter2, 1) To UBound(ListeDesOngletsAEcarter2, 1)
            If ListeDesOngletsAEcarter2(I) = ShSource.Name Then
               OngletACopier = False
               Exit For
            End If
        Next I
        If OngletACopier = True Then
           With ShSource
                NomInitial = .Name
                If Len(NomInitial) > 29 Then
                   .Name = LettreRepere & Mid(NomInitial, 1, 29)
                Else
                   .Name = LettreRepere & NomInitial
                End If
                .Copy After:=FichierCible2.Sheets(FichierCible2.Sheets.Count)
                .Name = NomInitial
           End With
        End If
    Next ShSource
    FichierSource.Close False 'ferme le dossier source sans sauvegarder
    Set FichierSource = Nothing
 
End Sub

[mederick]

Merci, j'ai réussi à retirer du nom des onglets la LettreRepere par contre les onglets ne se trie pas par ordre alphabétique après la copie dans le classeur.

Si tu sais comment je peux l'implémenter ce serait gentil.
Bien à toi,

[Invité]

Le fichier joint dans le post #6 de ce message onglets-organiser-colorer-partir-d-tableau-variable contient une procédure permettant de trier les onglets.

[mederick]

Merci mais en regardant le code je n'arrive pas à isoler la procédure de tri des onglets de celle de mise en couleur..

Bien à toi,

[Invité]

,

Le principe est de faire l'inventaire des noms d'onglets hors Synthèse sur un onglet annexe avec une boucle.
Trier la liste des noms dans l'ordre croissant.
Déplacer les onglets dans cet ordre également avec une boucle.

[mederick]

Merci Eric, je vais tenter de coder le tri des onglets d'ici cette semaine, mais je pense que je te reposerai des questions (vu la complexité et mon peu de connaissances en VBA).

Je voulais savoir également quel code tu entrerais pour que VBA fasse le process suivant:

Pour chaque cellule de A4 à A28 dans ma feuille Synthèse si le nom compris à l'intérieur de cette cellule est égale au nom d'un onglet alors que la macro aille :
- copier dans la feuille trouvée le chiffre compris dans la dernière cellule de la colonne E. (ça doit être un chiffre)
-coller dans ma feuille Synthèse sur la ligne en cours de vérification et dans la colonne E.

Merci pour ton aide, tes pistes pour que je puisse travailler dessus

Bien à toi

[Invité]

Je voulais savoir également quel code tu entrerais pour que VBA fasse le process suivant:
Pour chaque cellule de A4 à A28 dans ma feuille Synthèse si le nom compris à l'intérieur de cette cellule est égale au nom d'un onglet alors que la macro aille :
- copier dans la feuille trouvée le chiffre compris dans la dernière cellule de la colonne E. (ça doit être un chiffre)
-coller dans ma feuille Synthèse sur la ligne en cours de vérification et dans la colonne E.
i

Regarde la fonction Indirect sur l'excellent site de Jacques BOISGONTIER : RecupOnglets