Bonjour,
Je suis sur XL2007, et cherche à récupérer toutes les premières feuilles des classeurs d'un répertoire dans un nouveau classeur, votre code m'intéresse beaucoup, et au passage, merci de l'avoir posté.
Je pense que dans mon cas, l'adaptation se fait au niveau de ce module :
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
| Sub Copie(NomFich As String, FL1 As Workbook)
Application.EnableEvents = False
For Each LaFeuille In Workbooks(NomFich).Worksheets
'MsgBox LaFeuille.Name
On Error Resume Next
LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
DoEvents
If ActiveSheet.Protect = True Then ActiveSheet.Unprotect
ActiveSheet.UsedRange.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
If Err <> 0 Then
msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
Err.Clear
On Error GoTo 0
End If
DoEvents
If Cpt Mod 200 = 0 Then
ThisWorkbook.Save
DoEvents
End If
Next
Application.EnableEvents = True
'Fermeture du classeur
Application.DisplayAlerts = False
Workbooks(NomFich).Close False
Application.DisplayAlerts = True
DoEvents
End Sub |
J'ai tenté de le modifier de la manière suivante, mais je ça bloque sur la ligne
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
Avec un message d'erreur 1004 sur une incompatibilité de zone copier et zone coller.
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 Copie(NomFich As String, FL1 As Workbook)
Application.EnableEvents = False
' For Each LaFeuille In Workbooks(NomFich).Worksheets
'MsgBox LaFeuille.Name
'On Error Resume Next
'partie modifiée
Workbooks(NomFich).Sheets(1).Copy After:=FL1.Sheets(FL1.Sheets.Count)
DoEvents
If ActiveSheet.Protect = True Then ActiveSheet.Unprotect
ActiveSheet.UsedRange.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
If Err <> 0 Then
msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
Err.Clear
On Error GoTo 0
End If
DoEvents
If Cpt Mod 200 = 0 Then
ThisWorkbook.Save
DoEvents
End If
'Next
Application.EnableEvents = True
'Fermeture du classeur
Application.DisplayAlerts = False
Workbooks(NomFich).Close False
Application.DisplayAlerts = True
DoEvents
End Sub |
Merci pour votre aide.
Cordialement,
Partager