Aide sur code VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

Soleil11

XLDnaute Occasionnel
Bonjour,

Je voudrais modifier la macro ci-dessous , mais je n'arrive pas à obtenir le résultat voulu. En feuille 1 lorsque je fais tourner cette marcro je n'obtiens pas le résultat voulu. En feuille 2 j'ai ajouté le contenu de ce je voudrais obtenir. Pourriez-vous m'aider à obtenir ce résultat. J'ai mis en annexe les fichiers concernés par cette macro. La macro se trouve en classeur1.xls

Macro ci-dessous :

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long, Ligne2 As Long
Temp = Dir("C:\Test" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Classeur1.xls" Then
Workbooks.Open "C:\Test" & "\" & Temp
Ligne2 = Workbooks(Temp).Sheets(1).Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Count
Workbooks(Temp).Sheets(1).Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Workbooks("Classeur1.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("B" & CStr(Ligne)).Select
ActiveSheet.Paste
Range("A" & CStr(Ligne), "A" & Ligne + Ligne2 - 1).Value = Temp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Merci de votre aide.

Soleil11😀
 

Pièces jointes

Trier par date Trier par votes
Re : Aide sur code VBA

Bonsoir


Cela semble OK ainsi

Code: 
Sub XConsolidation()
Dim Temp As String, Ligne As Long, Lig As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Temp = Dir("C:\Test" & "\*.xls")
Application.ScreenUpdating = False
Do While Temp <> ""
If Temp <> "Classeur1.xls" Then
Workbooks.Open "C:\Test" & "\" & Temp
Lig = Workbooks(Temp).Sheets(1).UsedRange.Rows.Count
Ligne = ws.Range("A65536").End(xlUp).Row
ws.Cells(Ligne + 1, "A").Resize(Lig).Value = Temp
Workbooks(Temp).Sheets(1).UsedRange.Copy _
ws.Range("B" & Ligne + 1)
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Rows(1).Delete
Application.ScreenUpdating = True
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Aide sur code VBA

Staple1600 à dit:
Bonsoir


Cela semble OK ainsi

Code: 
Sub XConsolidation()
Dim Temp As String, Ligne As Long, Lig As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Temp = Dir("C:\Test" & "\*.xls")
Application.ScreenUpdating = False
Do While Temp <> ""
If Temp <> "Classeur1.xls" Then
Workbooks.Open "C:\Tempa" & "\" & Temp
Lig = Workbooks(Temp).Sheets(1).UsedRange.Rows.Count
Ligne = ws.Range("A65536").End(xlUp).Row
ws.Cells(Ligne + 1, "A").Resize(Lig).Value = Temp
Workbooks(Temp).Sheets(1).UsedRange.Copy _
ws.Range("B" & Ligne + 1)
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Rows(1).Delete
Application.ScreenUpdating = True
End Sub
Cliquez pour agrandir...

Bonjour Staple1600,

Cela marche très bien mais j'aimerais juste comprendre ce qui n'était pas correct. Quels étaient les paramètres qui ne jouaient pas ? Est-il possible pour vous de me donner quelques commentaires ainsi je pourrais essayer de m'améliorer. Quel est la différence entre "usedrange" et une selection "Range(Selection, ActiveCell.SpecialCells(xlLastCell))" ?

Merci de m'aider à comprendre.

Soleil11🙂
 
Vote positif 0 Vote négatif
Re : Aide sur code VBA

Bonjour

UsedRange, propriété - Exemple
Cet exemple montre comment sélectionner la plage utilisée dans la feuille Sheet1.
Worksheets("Sheet1").Activate
ActiveSheet.UsedRange.Select
Cliquez pour agrandir...
(ceci provient de l'aide de VBA : Dans Excel, faire ALT+F11 puis F1 )

En général, on peut se passer d'utiliser Select, Selection, Activate dans le code d'une macro

Voici une version modifiée et commentée
Code: 
Sub X2Consolidation()
[COLOR=Green]'Déclarations[/COLOR]
Dim Ligne As Long, Lig As Long
Dim ws As Worksheet, WBk As Workbook, Temp$, Rep$, Fic$
[COLOR=Green]'////////////////////////////////////////////////////////[/COLOR]
Set ws = ThisWorkbook.Sheets(1) [COLOR=Green]'       <- Feuille de copie des données[/COLOR]
Rep = "C:\Test\": Fic = "*.xls" [COLOR=Green]'      <-Désignation du dossier/type de fichier[/COLOR]
Temp = Dir(Rep & Fic) [COLOR=Green]'                 <- ici on parcourt le dossier[/COLOR]
Application.ScreenUpdating = False [COLOR=Green]'    <- ici on fige l'écran[/COLOR]
    Do While Temp <> ""
        If Temp <> "Classeur1.xls" Then
        Set WBk = Workbooks.Open(Rep & Temp) [COLOR=Green]'<- ici on ouvre le classeur trouvé[/COLOR]
        Lig = WBk.Sheets(1).UsedRange.Rows.Count [COLOR=Green]'<- Nombre de lignes utilisées[/COLOR]
        Ligne = ws.[A65536].End(xlUp).Row [COLOR=Green]'<- ligne dernière cellule non vide[/COLOR]
        ws.Cells(Ligne + 1, "A").Resize(Lig).Value = Temp [COLOR=Green]'<-copie des noms de fichiers[/COLOR]
        WBk.Sheets(1).UsedRange.Copy ws.Range("B" & Ligne + 1)
        [COLOR=Green]'<- copie des données des données sources dans Feuil1[/COLOR]
        WBk.Close[COLOR=Green] '<- fermeture du classeur[/COLOR]
        End If
    Temp = Dir
    Loop
Rows(1).Delete [COLOR=Green]'<- suppression 1ère ligne (esthétique)[/COLOR]
Set WBk = Nothing [COLOR=Green]'<- reset variable WBk[/COLOR]
Application.ScreenUpdating = True [COLOR=Green]'<- ici on défige l'écran[/COLOR]
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Aide sur code VBA

Staple1600 à dit:
Bonjour

(ceci provient de l'aide de VBA : Dans Excel, faire ALT+F11 puis F1 )

En général, on peut se passer d'utiliser Select, Selection, Activate dans le code d'une macro

Voici une version modifiée et commentée
Code: 
Sub X2Consolidation()
[COLOR=Green]'Déclarations[/COLOR]
Dim Ligne As Long, Lig As Long
Dim ws As Worksheet, WBk As Workbook, Temp$, Rep$, Fic$
[COLOR=Green]'////////////////////////////////////////////////////////[/COLOR]
Set ws = ThisWorkbook.Sheets(1) [COLOR=Green]'       <- Feuille de copie des données[/COLOR]
Rep = "C:\Test\": Fic = "*.xls" [COLOR=Green]'      <-Désignation du dossier/type de fichier[/COLOR]
Temp = Dir(Rep & Fic) [COLOR=Green]'                 <- ici on parcourt le dossier[/COLOR]
Application.ScreenUpdating = False [COLOR=Green]'    <- ici on fige l'écran[/COLOR]
    Do While Temp <> ""
        If Temp <> "Classeur1.xls" Then
        Set WBk = Workbooks.Open(Rep & Temp) [COLOR=Green]'<- ici on ouvre le classeur trouvé[/COLOR]
        Lig = WBk.Sheets(1).UsedRange.Rows.Count [COLOR=Green]'<- Nombre de lignes utilisées[/COLOR]
        Ligne = ws.[A65536].End(xlUp).Row [COLOR=Green]'<- ligne dernière cellule non vide[/COLOR]
        ws.Cells(Ligne + 1, "A").Resize(Lig).Value = Temp [COLOR=Green]'<-copie des noms de fichiers[/COLOR]
        WBk.Sheets(1).UsedRange.Copy ws.Range("B" & Ligne + 1)
        [COLOR=Green]'<- copie des données des données sources dans Feuil1[/COLOR]
        WBk.Close[COLOR=Green] '<- fermeture du classeur[/COLOR]
        End If
    Temp = Dir
    Loop
Rows(1).Delete [COLOR=Green]'<- suppression 1ère ligne (esthétique)[/COLOR]
Set WBk = Nothing [COLOR=Green]'<- reset variable WBk[/COLOR]
Application.ScreenUpdating = True [COLOR=Green]'<- ici on défige l'écran[/COLOR]
End Sub
Cliquez pour agrandir...

Bonjour JM,

Je te remercie cela m'a vraiement aidé, je pourrais sûrement utilisé à nouveau ces codes dans d'autre macros et j'y vois vraiement plus claire....

Soleil11🙂
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

deudecos
  • Résolu(e)
XL pour MAC Code vba pour recherche sur une seule ligne
Réponses
4
Affichages
184
deudecos
deudecos
U
  • Question Question
Autres Quelques fois ça bug feuilles cachées
Réponses
2
Affichages
254
cathodique
cathodique
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
430
patricktoulon
patricktoulon
M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
432
MOLY_
M
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
818
thunder23
thunder23
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
923
AtTheOne
AtTheOne
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA ADODB doublons
Réponses
1
Affichages
325
dysorthographie
dysorthographie
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
792
ph.vanne
ph.vanne
J
  • Question Question
Microsoft 365 Copie des onglets dans un fichier séparé depuis une liste en VBA
Réponses
3
Affichages
511
job75
job75
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
525
xavieralvaro
X
J
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
1 K
jebibo
J
arck
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
646
AtTheOne
AtTheOne
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
497
eric72
E
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
756
Oneida
Oneida
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
857
Chaton77
Chaton77
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
647
safranien
S
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
243
vazvaz
V
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
427
Pierreavecunp
P
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
562
Yogean
Y
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
772
Gégé-45550
Gégé-45550
Retour