Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 5A8CDCBC-3D16-465B-854B-DC4277DA31AC@microsoft.com...
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 3AF6ACC2-79A0-4BCF-A2A7-7E1934ECD7C0@microsoft.com...
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'
Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" <ONGLET@discussions.microsoft.com> a écrit dans le message de news:
AE54E5E2-D38C-4597-BB85-E88610637341@microsoft.com...
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que
cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final
?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 5A8CDCBC-3D16-465B-854B-DC4277DA31AC@microsoft.com...
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que
cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 3AF6ACC2-79A0-4BCF-A2A7-7E1934ECD7C0@microsoft.com...
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'
Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final
?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" <ONGLET@discussions.microsoft.com> a écrit dans le message de news:
AE54E5E2-D38C-4597-BB85-E88610637341@microsoft.com...
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que
cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final
?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 5A8CDCBC-3D16-465B-854B-DC4277DA31AC@microsoft.com...
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 3AF6ACC2-79A0-4BCF-A2A7-7E1934ECD7C0@microsoft.com...
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'
Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" <ONGLET@discussions.microsoft.com> a écrit dans le message de news:
AE54E5E2-D38C-4597-BB85-E88610637341@microsoft.com...
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Utilise cette procédure en remplacement de celle portant le même nom contenuue dans le message d'hier.
'------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Je viens de passer ton code dans un module, cependant il me renvoi une
erreur ...
La ligne : Set Dest = Workbooks.Open(NomComplet) // ne renvoi pas vers un
fichier ... enfin, NomComplet renvoi vers "101050 Omifpro" (le 1er fichier de
la liste), mais Dest renvoi vers "Nothing".
A noter que je travail sous un excel US ...
Merci de ton aide.
Vad'
Ps : Le code que j'ai entré :
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "C:Documents and SettingsatopsentMy DocumentsCPverifier"
'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "101050" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------Bonjour Vader,
Voici une procédure qui fera le travail.
Tu copies ce qui suit dans un module standard
Dans cette procédure,
Function TrouverLaFeuille(Wks As Workbook)
Il y a cette ligne de code qui doit trouver le " n° de réf interne"
If Sh.CodeName = "Feuil1"
Tu dois adapter !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Il est préférable d'être clair lorsque l'on pose une question dans son énoncé. L.'expression que tu utilises : "un n° de réf
interne" , Tu dois être le seul à savoir ce que c'est. Dis comme les gens à qui tu demandes de l'aide peuvent savoir ce que cela
veut dire ?
Renseigne adéquatement le répertoire dans lequel se retrouve tous tes fichiers.
'--------------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Atravail" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do
OuvrirFichier NomFichier, Wk
'NomFichier = Dir()
NomFichier = ""
Loop While NomFichier <> ""
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'--------------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'--------------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'--------------------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
les feuilles ont des noms différents mais avec un n° de réf interne.
La structure est toujours la même.
Le truc s'est d'obtenir un cumul des fichiers de départ dans un sens et
unique fichier (1 onglet par fichier de départ - 65 fichiers -> 65 onglets).
Les onglets doivent être copiés tels quel pour les traitements futurs.
Merci,
Vad'Bonjour Onglet,
Est-ce que tes feuilles possèdent toutes le même nom ? Ont-ils toutes la même structure des données... si oui quelles sont les
colonnes utilisées ? Désires-tu seulement les données ou les formules des feuilles sources si il y en a dans le fichier final ?
Où sont tes fichiers, Tous dans le même répertoire ?
Salutations!
"ONGLET" a écrit dans le message de news:
Petit problème épineux :
Je dois copier plusieurs onglets (65) et les rassembler sous un seul
classeur xls.
Problème :
Les fameux 65 onglets sont présents dans autant de fichiers xls ...
Existe-il / Est-il possible d'automatiser la copie de ses onglets ? ... car
à l'heure actuelle, je dois ouvrir chaque fichier xls, puis faire une copie
de l'onglet vers le classeur où les 65 onglets seront rassembler ... long,
très long.
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Ceci :
'------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Dest.Sheets.Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
End Sub
'------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Effectivement, la fonction TrouverLaFeuille pose problème, j'ai essayé de
modifier le nom des onglets en simplifiant (appelés "OK") et demandé de
chercher "OK", mais toujours la même erreur...
Alors, je te propose de supprimer cette recherche, on se limite à demander
une copie sans restrictions ... la macro copie tous les onglets qu'elle
rencontre dans un seul fichier. Rien que cela me fera gagner du temps ... et
puis ça va m'obliger à apprendre les macro pour la modifier plus tard.
Merci,
Vad'Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Ceci :
'------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Dest.Sheets.Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
End Sub
'------------------------
Salutations!
"Vader" <Vader@discussions.microsoft.com> a écrit dans le message de news: 7C06EB3D-2F51-40CB-82B8-EFC97B22C1B1@microsoft.com...
Bonjour,
Effectivement, la fonction TrouverLaFeuille pose problème, j'ai essayé de
modifier le nom des onglets en simplifiant (appelés "OK") et demandé de
chercher "OK", mais toujours la même erreur...
Alors, je te propose de supprimer cette recherche, on se limite à demander
une copie sans restrictions ... la macro copie tous les onglets qu'elle
rencontre dans un seul fichier. Rien que cela me fera gagner du temps ... et
puis ça va m'obliger à apprendre les macro pour la modifier plus tard.
Merci,
Vad'
Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
Ceci :
'------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Dest.Sheets.Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
End Sub
'------------------------
Salutations!
"Vader" a écrit dans le message de news:
Bonjour,
Effectivement, la fonction TrouverLaFeuille pose problème, j'ai essayé de
modifier le nom des onglets en simplifiant (appelés "OK") et demandé de
chercher "OK", mais toujours la même erreur...
Alors, je te propose de supprimer cette recherche, on se limite à demander
une copie sans restrictions ... la macro copie tous les onglets qu'elle
rencontre dans un seul fichier. Rien que cela me fera gagner du temps ... et
puis ça va m'obliger à apprendre les macro pour la modifier plus tard.
Merci,
Vad'Bonjour Vader,
Essaie ceci :
Cependant, la fonction : "Function TrouverLaFeuille(Wks As Workbook)"
ne sait toujours pas comment retrouver la feuille à partir du : "un n° de réf interne"
Salutations!
'---------------------------------
Sub Compilation()
Dim NomFichier As String
Dim Repertoire As String
Dim Wk As Workbook, Depart As String
Repertoire = "c:Excel" 'à déterminer
NomFichier = Dir(Repertoire & "*.xls")
Application.ScreenUpdating = False
Depart = ThisWorkbook.Name
Set Wk = Workbooks.Add
Do While NomFichier <> ""
OuvrirFichier Repertoire & NomFichier, Wk
NomFichier = Dir()
Loop
Application.DisplayAlerts = False
Worksheets(Array("Feuil1", "Feuil2", "Feuil3")).Delete
Application.DisplayAlerts = True
Workbooks(Depart).Activate
End Sub
'---------------------------------
Sub OuvrirFichier(NomComplet As String, Wk As Workbook)
Dim Dest As Workbook, Feuille As String
Set Dest = Workbooks.Open(NomComplet)
Feuille = TrouverLaFeuille(Dest)
If Feuille <> "" Then
Dest.Worksheets(Feuille).Copy _
after:=Wk.Sheets(Wk.Sheets.Count)
Dest.Close False
Else
MsgBox "Impossible de trouver ladite feuille" & _
vbCrLf & "Pour ce classeur : " & Dest.Name & ".", _
vbInformation + vbOKOnly, "Attention"
End If
End Sub
'---------------------------------
Function TrouverLaFeuille(Wks As Workbook)
Dim Sh As Worksheet
For Each Sh In Wks.Worksheets
If Sh.CodeName = "Feuil1" Then 'à déterminer
TrouverLaFeuille = Sh.Name
Exit Function
End If
Next
End Function
'---------------------------------
