XL 2016 Copie feuille de plusieurs classeurs fermés vers classeur actif

  • Initiateur de la discussion Initiateur de la discussion Nestor
  • Date de début Date de début

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 !

Nestor

XLDnaute Nouveau
Bonjour à tous,
Tout nouveau sur ce super forum d'Expert!!

Voilà mon sujet:
J' utilise la macro suivante qui copie une feuille de chaque classeur fermé d'un dossier sur un classeur actif mais qui fonctionne seulement si le classeur destination comporte autant de feuille que de classeur source
J'ai 2 questions
1) Comment intégrer dans cette macro "Workbook Copy after" si le classeur destination ne comprend à l'origine qu'une seule feuille afin de rajouter une feuille après chaque boucle faite sur les classeurs sources?
2) Comment adapter cette macro si je veux copier seulement la feuille du dernier classeur enregistré dans le dossier source (dossier comprenant de 1 à 12 classeurs, un par mois)

Sub ImportCGM()

Dim Cn As ADODB.Connection
Dim Fichier As String, chemin As String, i As Long
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset

chemin = "C:\Users\G\Desktop\Mensuel"
Fichier = Dir(chemin & "\*.xlsm")
NomFeuille = Feuil1.Name

i = 1

Do While Fichier <> ""
If Fichier <> ThisWorkbook.Name Then

Set Cn = New ADODB.Connection

With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With

texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"

Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)

Sheets(i).Range("A1").CopyFromRecordset Rst

Cn.Close
Set Cn = Nothing
i = i + 1
End If
Fichier = Dir
Loop
End Sub
Merci infiniment pour vos réponses
 
- 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

Réponses
3
Affichages
534
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
637
Réponses
9
Affichages
383
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
76
Retour