Bonjour,
Grâce aux forumers ExcelDownloads, j'ai pu obtenir la macro suivante qui fonctionne parfaitement bien, à un détail près et qui s'avère un peu gênant au fil du temps !!!
Cette macro sert à copier des lignes contenues dans différentes feuilles de différents classeurs contenus dans un même dossier. A chaque fois que je lance la macro, j'ai le message ci-dessous qui apparait et que je dois valider par OUI. Est-il possible d'intégrer du code dans la macro pour automatiser ce clic sur le OUI ?
Merci d'avance pour vos réponses
Bien cordialement,
Régis
Sub Synthese_Fichiers()
Dim Chemin As String, Fichier As String, Synthese As String
Dim wSynthese As Workbook, wFichier As Workbook
Dim Feuilles
Dim i As Long, j As Long, c
'Définit le répertoire d'origine des fichiers (identique pour la synthèse et les autres)
Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\*.xlsx")
Synthese = ThisWorkbook.Name
'Définit la variable classeur
Set wSynthese = ThisWorkbook
Feuilles = Array("PQF1", "PQF2", "PQF3", "PQF4", "PQF5", "PQF6_a", "PQF6_b", "PQF6_c", "PQF8", "PQF9")
'Boucle sur tous les fichiers du répertoire
'On vérifie que le nom du fichier est différent de celui de synthèse
'Et que le fichier dispose bien d'un nom
Do While Fichier <> Synthese And Len(Fichier) > 0
'On ouvre le fichier et on définit la variable
Workbooks.Open (Chemin + "\" + Fichier): Set wFichier = ActiveWorkbook
'On boucle chaque feuille du classeur
For Each c In Feuilles
'On définit la dernière ligne de chaque onglet
i = wSynthese.Sheets(c).[d65000].End(xlUp).Row + 1 '+1 pour coller après la dernière ligne
j = wFichier.Sheets(c).[d65000].End(xlUp).Row
'On vérifie que la dernière ligne (j) soit supérieure à 5 et on copie colle les lignes
'Sinon on passe à la prochaine étape
If j > 5 Then wFichier.Sheets(c).Rows("6:" & j).Copy wSynthese.Sheets(c).Cells(i, "a")
Next c
'On ferme le classeur ouvert
wFichier.Close False
Fichier = Dir()
Loop
'A conserver si tu le souhaites seulement
With wSynthese
For Each c In Feuilles
j = 1
For i = 6 To .Sheets(c).[a65000].End(xlUp).Row Step 2
.Sheets(c).Cells(i, "a").Value = j
j = j + 1
Next i
Next c
End With
End Sub
Grâce aux forumers ExcelDownloads, j'ai pu obtenir la macro suivante qui fonctionne parfaitement bien, à un détail près et qui s'avère un peu gênant au fil du temps !!!
Cette macro sert à copier des lignes contenues dans différentes feuilles de différents classeurs contenus dans un même dossier. A chaque fois que je lance la macro, j'ai le message ci-dessous qui apparait et que je dois valider par OUI. Est-il possible d'intégrer du code dans la macro pour automatiser ce clic sur le OUI ?
Merci d'avance pour vos réponses
Bien cordialement,
Régis
Sub Synthese_Fichiers()
Dim Chemin As String, Fichier As String, Synthese As String
Dim wSynthese As Workbook, wFichier As Workbook
Dim Feuilles
Dim i As Long, j As Long, c
'Définit le répertoire d'origine des fichiers (identique pour la synthèse et les autres)
Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\*.xlsx")
Synthese = ThisWorkbook.Name
'Définit la variable classeur
Set wSynthese = ThisWorkbook
Feuilles = Array("PQF1", "PQF2", "PQF3", "PQF4", "PQF5", "PQF6_a", "PQF6_b", "PQF6_c", "PQF8", "PQF9")
'Boucle sur tous les fichiers du répertoire
'On vérifie que le nom du fichier est différent de celui de synthèse
'Et que le fichier dispose bien d'un nom
Do While Fichier <> Synthese And Len(Fichier) > 0
'On ouvre le fichier et on définit la variable
Workbooks.Open (Chemin + "\" + Fichier): Set wFichier = ActiveWorkbook
'On boucle chaque feuille du classeur
For Each c In Feuilles
'On définit la dernière ligne de chaque onglet
i = wSynthese.Sheets(c).[d65000].End(xlUp).Row + 1 '+1 pour coller après la dernière ligne
j = wFichier.Sheets(c).[d65000].End(xlUp).Row
'On vérifie que la dernière ligne (j) soit supérieure à 5 et on copie colle les lignes
'Sinon on passe à la prochaine étape
If j > 5 Then wFichier.Sheets(c).Rows("6:" & j).Copy wSynthese.Sheets(c).Cells(i, "a")
Next c
'On ferme le classeur ouvert
wFichier.Close False
Fichier = Dir()
Loop
'A conserver si tu le souhaites seulement
With wSynthese
For Each c In Feuilles
j = 1
For i = 6 To .Sheets(c).[a65000].End(xlUp).Row Step 2
.Sheets(c).Cells(i, "a").Value = j
j = j + 1
Next i
Next c
End With
End Sub
