Aide macro excel
Fermé
yoyo76_6
-
8 juil. 2010 à 16:50
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 13 juil. 2010 à 09:12
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 13 juil. 2010 à 09:12
A voir également:
- Aide macro excel
- Liste déroulante excel - Guide
- Formule excel - Guide
- Déplacer une colonne excel - Guide
- Convertir chiffre en lettre excel sans macro ✓ - Forum Excel
- Aller à la ligne excel - Guide
1 réponse
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
13 juil. 2010 à 09:12
13 juil. 2010 à 09:12
Salut,
Pas trop tard??
Une solution :
1- créer un fichier excel et le nommer : suivi.xls
2- dans ce classeur, aleez sous VBA (CTRL+F11)
3- Insertion/Module
4- copier/coller ce code dans le module puis fermez la fenêtre VBA :
[Les sources sont citées en commentaire dans ce code.]
Enregistrer le classeur suivi.xls, puis lancez la macro par CTRL+F8, choisir : copie_feuilles et cliquer sur Exécuter.
Bon courage
Pas trop tard??
Une solution :
1- créer un fichier excel et le nommer : suivi.xls
2- dans ce classeur, aleez sous VBA (CTRL+F11)
3- Insertion/Module
4- copier/coller ce code dans le module puis fermez la fenêtre VBA :
Sub copie_feuilles()
'http://www.commentcamarche.net/faq/16109-excel-convertir-fichier-s-csv-xls#selectionner-le-chemin-par-boite-de-dialogue
'Lermitte222
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim tablo
Dim nomfich, nomfeuil As String
Dim i As Integer
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
Set oFolderItem = objFolder.Items.Item
chemin = oFolderItem.Path
Set objShell = Nothing
Set objFolder = Nothing
Set oFolderItem = Nothing
'------------------------------------------
'http://www.commentcamarche.net/forum/affich-7805734-vba-excel-lister-fichiers-caracteristique
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = chemin
.SearchSubFolders = True
.Filename = "xls"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
For Each NomFic In .FoundFiles
Workbooks.Open Filename:=NomFic
'------------------------------------------
'http://www.commentcamarche.net/forum/affich-18381562-trouver-un-fichier-vba-excel#5
'michel_m
tablo = Split(NomFic, "\")
nomfich = tablo(UBound(tablo))
nomfeuil = Left(nomfich, 2)
With Workbooks("suivi.xls")
For i = 1 To .Sheets.Count
If .Sheets(i).Name = nomfeuil Then
MsgBox "La feuille " & nomfeuil & " existe déjà"
GoTo suivant
End If
Next
End With
'-------------------------------------------
Workbooks(nomfich).Sheets("Feuil1").Select
Workbooks(nomfich).Sheets("Feuil1").Copy After:=Workbooks("suivi.xls").Sheets(3)
ActiveSheet.Name = nomfeuil
suivant:
Workbooks(nomfich).Activate
Workbooks(nomfich).Close
Next
End With
[Les sources sont citées en commentaire dans ce code.]
Enregistrer le classeur suivi.xls, puis lancez la macro par CTRL+F8, choisir : copie_feuilles et cliquer sur Exécuter.
Bon courage