Bonjour,
ce code est sensé extraire 45 onglets issus de différents classeurs et les copier dans un seul et unique fichier .
Problème: au bout du 43 ème onglets importés j'ai une erreur 1004 "la méthode copy de la classe worksheet a échoué".
Solution préconnisée par microsoft:il faudrait qu'après chaque onglet importé, le classeur soit fermé.La présente macro le fait mais à la fin (donc après avoir ouvert + d'une quarantaine de classeur).
Pouvez m'aider à adapter le code pour qu'après chaque importation de d'onglet le classeur se ferme ou tout autre suggestion.
Le fichier étant lourd , je ne peux que vous transmettre le code.J'espère que cela pourra suffire.
CORDIALEMENT
Sub Extraction_de_tous_les_onglets_produit()
Dim nblig As Integer
Dim chemin As String
Dim nom_classeur_TABLO2010 As String
Dim posi_ongl As Variant
Dim classeur As Object
Dim feuill As Object
Call formule
posi_ongl = Sheets.Count
nom_classeur_TABLO2010 = ActiveWorkbook.Name
Sheets("Liste_fichiers_TABLO2010").Visible = True
For Each feuill In ActiveWorkbook.Worksheets
If feuill.Name Like "produits*" Then
feuill.Delete
End If
Next feuill
'ouvre 1 par 1 les 45 fichiers et extrait l'onglet appelé "produit*"
Sheets("Liste_fichiers_TABLO2010").Select
nblig = Sheets("Liste_fichiers_TABLO2010").Application.WorksheetFunction.CountA(Range("A:A"))
For i = 1 To nblig
Range("A" & i).Select
chemin = Range("A" & i).Value
posi_ongl = Sheets.Count
'chemin = chemin d'accès au fichier à ouvrir
Workbooks.Open Filename:=chemin
For Each feuill In ActiveWorkbook.Worksheets
'si la le nom de l'onglet contient le mot produit alors tu le copies
If feuill.Name Like "produits*" Then
feuill.Copy After:=Workbooks(nom_classeur_TABLO2010).Sheets(posi_ongl)
Sheets("Liste_fichiers_TABLO2010").Select
End If
'*********je pense que c'est à cet endroit ou le classeur doit être fermé après avoir copier l'onglet et avant d'ouvrir un nouveau fichier.**********
Next feuill
Next i
'**********PARTIE DE CODE A REMPLACER*****************
'Fermeture de tous les classeurs ouverts à la fin de la macro
For Each classeur In Workbooks
If classeur.Name <> ThisWorkbook.Name Then
classeur.Close
End If
Next classeur
'**************************************************
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
ce code est sensé extraire 45 onglets issus de différents classeurs et les copier dans un seul et unique fichier .
Problème: au bout du 43 ème onglets importés j'ai une erreur 1004 "la méthode copy de la classe worksheet a échoué".
Solution préconnisée par microsoft:il faudrait qu'après chaque onglet importé, le classeur soit fermé.La présente macro le fait mais à la fin (donc après avoir ouvert + d'une quarantaine de classeur).
Pouvez m'aider à adapter le code pour qu'après chaque importation de d'onglet le classeur se ferme ou tout autre suggestion.
Le fichier étant lourd , je ne peux que vous transmettre le code.J'espère que cela pourra suffire.
CORDIALEMENT
Sub Extraction_de_tous_les_onglets_produit()
Dim nblig As Integer
Dim chemin As String
Dim nom_classeur_TABLO2010 As String
Dim posi_ongl As Variant
Dim classeur As Object
Dim feuill As Object
Call formule
posi_ongl = Sheets.Count
nom_classeur_TABLO2010 = ActiveWorkbook.Name
Sheets("Liste_fichiers_TABLO2010").Visible = True
For Each feuill In ActiveWorkbook.Worksheets
If feuill.Name Like "produits*" Then
feuill.Delete
End If
Next feuill
'ouvre 1 par 1 les 45 fichiers et extrait l'onglet appelé "produit*"
Sheets("Liste_fichiers_TABLO2010").Select
nblig = Sheets("Liste_fichiers_TABLO2010").Application.WorksheetFunction.CountA(Range("A:A"))
For i = 1 To nblig
Range("A" & i).Select
chemin = Range("A" & i).Value
posi_ongl = Sheets.Count
'chemin = chemin d'accès au fichier à ouvrir
Workbooks.Open Filename:=chemin
For Each feuill In ActiveWorkbook.Worksheets
'si la le nom de l'onglet contient le mot produit alors tu le copies
If feuill.Name Like "produits*" Then
feuill.Copy After:=Workbooks(nom_classeur_TABLO2010).Sheets(posi_ongl)
Sheets("Liste_fichiers_TABLO2010").Select
End If
'*********je pense que c'est à cet endroit ou le classeur doit être fermé après avoir copier l'onglet et avant d'ouvrir un nouveau fichier.**********
Next feuill
Next i
'**********PARTIE DE CODE A REMPLACER*****************
'Fermeture de tous les classeurs ouverts à la fin de la macro
For Each classeur In Workbooks
If classeur.Name <> ThisWorkbook.Name Then
classeur.Close
End If
Next classeur
'**************************************************
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
