Macro déplacer feuil hidden des classeurs fermés sur classeur actif

[shamben]

Bonjour,

Je vous serais énormément reconnaissant si vous pouvez m'aider sur un projet boulot dans les RH, de mutualisation de feuilles Excel.

je suis débutant en programmation VBA. ma base en raisonnement math me permet de comprendre la logique de programmation structurée et non objet.
je suis un inconditionnel de ce site dont je remercie toutes les instances.

exposition du besoin:
Il y a plusieurs classeurs (ex.: toto.xls, tata.xls, dans un répertoire ex.:"D:\test") dans tous ces classeurs il y a une feuille invisible "RecupData" pleine de formules (références de cellules, de plages de lignes et des noms de feuilles).

1- chaque feuille de chaque classeur ("RecupData") je veux la copier et la coller en valeurs dans mon classeur actif "GLOBAL" en la renommant par le nom du classeur d'ou elle provient: j'aurais des feuilles ou onglets portant les noms "toto", "tata" sur GLOBAL.

Sauf que dans les feuilles j'ai les formules, je voudrais les valeurs, !!!!???
j'ai adapté le code suivant qui marche presque sauf pour la copie ne valeur:


Sub TtesFeuilsDsGLOBAL()
Dim F, Wbk As Worksheet
Dim Rep As String ' répertoire à traiter
Dim Classeur As String, Onglet As String
Dim i As Byte
Dim rRange As Range

Rep = mDF_ChoixDossier("Choisissez le répertoire à regrouper")
If Rep = "" Then Exit Sub
Classeur = Dir(Rep & "\*.xls")

Do While Classeur <> Empty
With Workbooks.Open(Rep & "\" & Classeur)




For i = 1 To 1 'A adapter
Onglet = Choose(i, "RecupData") 'A adapter

'Set .rRange = Range("L1:L200")
' rRange = rRange.Value



On Error Resume Next
Set F = .Sheets(Onglet)




On Error GoTo 0
If Not F Is Nothing Then

F.Copy After:=ThisWorkbook.Worksheets(1)

ActiveSheet.Name = Classeur

Set F = Nothing
End If
Next i

.Close False
End With
Classeur = Dir
Loop

' boucle pour rendre toutes les feuilles visibles
For Each Ws In ActiveWorkbook.Sheets
Ws.Visible = xlSheetVisible
Next Ws

End Sub
-----------------------------------------------------------
Function mDF_ChoixDossier(Titre As String) As String
'myDearFriend! - www.mdf-xlpages.com
Dim objFolder As Object
Dim Chemin As String
Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, Titre, 513, 0)
If objFolder Is Nothing Then Exit Function
On Error Resume Next
Chemin = objFolder.Items.Item.Path & ""
On Error GoTo 0
mDF_ChoixDossier = IIf(Left(Chemin, 1) = ":", "", Chemin)
End Function
----------------------------------------------------

2- une deuxième macro devrait mettre toutes les lignes de toutes les feuilles (toto,tata) dans une seul feuille "GLOBAL.xls!DBGlobale".
d'avance merci,

 

[Guest]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

Bonjour Shamben et bienvenue sur le forum,

voici les lignes modifiées concernant le copier/coller spécial valeur:

If Not F Is Nothing Then
'Copier uniquement les cellules occupées
F.UsedRange.Copy
ThisWorkbook.Sheets.Add before:=Sheets(1)
With ActiveSheet
.Name = Classeur
'Ne coller que les valeurs en fonction de "A1"
.Range("A1").PasteSpecial Paste:=xlPasteValues
End With
Set F = Nothing
End If

Si tu as un peu de pratique du site, édite tes posts dans l'éditeur avancé, ce qui te permettra d'utiliser le bouton '#' pour éditer tes codes. Ils en seront plus lisibles.

A+

 

[shamben]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

tout d'abords, Merci pour ce retour rapide de réponse:



j'ai fait la modif; mais la macro lancée à partir d'un bouton sur "feuil1" bloque "
erreur d'exécution '1004'...."
sur la ligne ".Name = Classeur" . les noms des feuilles crées sur GLOBAL se lisent désormais feuil2; feuil3....et non comme avant: "toto.xls"; "tata.xls"

 

[Guest]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

Re,

Vérifie le contenu de la variable Classeur
Difficile à distance de trouver exactement ce qui ne va pas.
A+

 

[shamben]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

je dois partir, je vous reviens demain avec plus de precision et des fichiers joints

merci pour votre patience

 

[shamben]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

rebonjour,

il ya un pb avec :
------------------
With ActiveSheet
.Name = Classeur
'Ne coller que les valeurs en fonction de "A1"
.Range("A1").PasteSpecial Paste:=xlPasteValues
End With
---------------------------
car l'exécution de la macro se fait dans le classeur source, elle prends la deuxième feuille non vide et transforme son nom "toto.xls" càd en son nom de classeur; puis rajoute une feuille vide "feuil2 ou ...3,4..."sur le classeur destination GLOBAL.xls

 

[Guest]

Re : Macro déplacer feuil hidden des classeurs fermés sur classeur actif

Re,

Bon si le classeur qui contient la macro est le classeur "GLOBAL.xls" (ThisWorkBook dans la macro) alors ceci devrait le faire.

J'ai enlevé la boucle For apparament inutile ici.

Sub TtesFeuilsDsGLOBAL()
    Dim ShSource As Worksheet
    Dim shDestination As Worksheet
    Dim Rep As String    ' répertoire à traiter
    Dim NomClasseur As String
    Dim rRange As Range
    Rep = mDF_ChoixDossier("Choisissez le répertoire à regrouper")
    If Rep = "" Then Exit Sub
    Classeur = Dir(Rep & "\*.xls")
    Do While Classeur <> Empty
        With Workbooks.Open(Rep & "\" & Classeur)
            On Error Resume Next
            Set ShSource = .Sheets("RecupData")
            On Error GoTo 0
            If Not ShSource Is Nothing Then
                Set shDestination = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                ShSource.UsedRange.Copy
                shDestination.Range("A1").PasteSpecial xlPasteValues
                shDestination.Name = Classeur
                Set ShSource = Nothing
                Set shDestination = Nothing
            End If
            .Close False
        End With
        Classeur = Dir
    Loop
End Sub

Tu devais revenir avec des fichiers exemples. Et utiliser le bouton '#' pour éditer tes codes.

A+