Discussion :

[mederick]

Bonjour,

Je voudrais svp avoir votre aide sur le code VBA que je dois écrire afin de copier les feuilles (moins de 10 feuilles par classeur) de 3 classeurs excel dans un seul nouveau classeur. Et si possible ranger les onglets de ce nouveau classeur par ordre alphabétique.

A chaque fois que je lance la macro, j'aimerais qu'un nouveau classeur soit créé ou que le nouveau classeur écrase l'ancien.

Merci par avance pour votre aide
Bien cordialement,

Math

[BENNASR]

Bonsoir
voila une piste à développer et à adapter à tes besoin
le principe consiste à aller ouvrir le dossier copier la feuille souhaitée dans le nv dossier puis fermer le dossier source.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub importDonnées()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Application.ScreenUpdating = False
Set wkA = ThisWorkbook ' le dossier qui contient le code et qui va recevoir les données
chemin = "Z:\TRAVAUX COMPTABLES BNA\Controle de Gestion\" ' adresse du dossier source
fichier = "RAPPORT JOURNALIER.xlsx" ' nom du dossier source
Workbooks.Open chemin & fichier
Set wkB = ActiveWorkbook
wkB.Sheets("Alf3").Copy After:=wkA.Sheets("ACCEUIL") 'l'onglet à copier nommée dans mon cas "Alf3" et le placement dans le dossier qui recevra les données après l'onglet ACCEUIL
wkB.Close True 'fermer le dossier source
 Application.ScreenUpdating = True
End Sub

J'espère que ça te permettre d'avancer
BONNE CONTINUATION

[mederick]

Merci beaucoup BENNASR,

Juste une précision stp:

- comment faire pour supprimer les feuilles existantes dans le classeur : la copie des feuilles vers mon nouveau classeur se passe bien, mais quand je veux updater mes feuilles de ce classeur en important à nouveau les feuilles du classeur source je me retrouve avec des doublons
- comment classer les onglets par ordre alphabétique?

Merci encore
Bien à toi

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
Sub importDonnées()
Dim wkA As Workbook, wkB As Workbook, wkC As Workbook, wkD As Workbook
Dim chemin As String, fichier As String
Dim j As Long
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
wkB.Sheets.Copy After:=wkA.Sheets("Synthèse") 'l'onglet à copier nommée dans mon cas "Alf3" et le placement dans le dossier qui recevra les données après l'onglet Synthèse
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
wkC.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
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
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
wkD.Close True 'fermer le dossier source
 
 Application.ScreenUpdating = True
End Sub

[BENNASR]

Bonjour
1/ Tu peux commencer par supprimer toutes les feuilles différentes de "Synthèse" et puis tu importes les nouvelles feuilles. à intégrer ds ton code

Code :

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

1
2
3
4
5
6
7
8
Dim w As Worksheet
Application.DisplayAlerts = False
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "Synthèse" Then
     w.Delete
End If
Next
Application.DisplayAlerts = True

2/ Pour mettre en ordre les feuilles importées et vu qu'il s'agit de 3 feuilles je crois que la plus simple et désigner l'emplacement via copy after
la première copy after "synthèse" et la deuxième copy after la première et ainsi de suite mais au moment de l’événement il faut que la feuille est déja importer donc il faut changer l'ordre de l'opération de copiage selon tes besoins

Code :

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

wkD.Sheets.Copy After:=wkA.Sheets("Synthèse")

BONNE CONTINUATION & BONNE JOURNÉE

[mederick]

Merci pour ton aide.

J'ai updaté le code, mais j'ai un bug que je n'arrive pas à fixer:
j'essaie d'exclure la copie de certains onglets dans mon classeur excel qui regroupe les onglets de plusieurs classeurs excel. Et ensuite de copier les onglets qui respectent ma condition if. Mais j'ai un bug.. Pourrais-tu stp m'aider à le résoudre?

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
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 dans mon cas "Alf3" et le placement dans le dossier qui recevra les données après l'onglet Synthèse
wkB.Close True 'fermer le dossier source
End If
Next
 
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
wkC.Close True 'fermer le dossier source
Next
End If
 
 
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
wkD.Close True 'fermer le dossier source
End If
Next
 
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

Merci beaucoup

[BENNASR]

Bonjour
Pour info je suis autodidacte et débutant VBA et mes connaissances sont limitées
mais je demande quelle ligne qui pose le problème et si tu enlève cette partie du code qui range les données par ordre alphabétique est ce que tu aura ce que tu veux et te manque que le rangement des onglets??

Code :

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

1
2
3
4
5
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

voila des liens utiles :

http://excel-malin.com/codes-sources...-alphabetique/

code de patricktoulon

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub met_en_ordre_alpha_les_feuilles()
 Dim X As Variant
 Dim I As Variant
 For Each X In ActiveWorkbook.Sheets
 For I = 2 To ActiveWorkbook.Sheets.Count
 If Sheets(I-1).Name>Sheets(I).Name Then
 Sheets(I-1).Move After:=Sheets(I)
 End If
 Next
 Next
 End Sub