VBA j'y suis presque...

C@thy · 28 Avril 2009

Bonsouar le forum,

j'essaie de copier une plage en cours depuis 2 fichiers vers un 3ème.

les 2 fichiers n'ont jamais le même nom car la date change (mais pas le début)

Code:

Dim fl As Integer, X As Integer
Dim Chem As String, Nomc As String, Nomf As String, cl As String
Dim Wbk As Workbook, WsD As Worksheet
Dim Fichiers As Object, Classeur As Object, NbFichiers As Integer
Dim Tableau() As String
Const WbkDD = "donnees_dossiers.xls"
Const WbkES = "Extraction_ServiceCenter"
Const WbkTe = "ACD templates"
Dim ListeF As FoundFiles, AFermer As Boolean
Dim ListeClasseurs As New Collection
Application.ScreenUpdating = True
Chem = ThisWorkbook.Path & "\"
cl = Dir(ThisWorkbook.Path & "\*.xls")
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
    Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chem).Files 'tous les classeurs du répertoire
    For Each Classeur In Fichiers
        If Right(Classeur.Name, 3) = "xls" And Classeur.Name <> ThisWorkbook.Name Then
                        If Left(Classeur.Name, 24) = WbkES Or Left(Classeur.Name, 13) = WbkTe Then
                ListeClasseurs.Add Classeur.Name
                NbFichiers = NbFichiers + 1
                ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = cl
cl = Dir()
            End If
        End If
    Next
'classeur DD comporte 8 feuilles à remplir onglets 1 à 8
'Outils Interactions Incidents Demandes Articles et Template appels 1 à Template appels 3
 For X = 1 To NbFichiers 'boucles sur les 2 classeurs
 For fl = 1 To 8
   Sheets(fl).Select
   Nomf = ActiveSheet.Name
  'copier la plage en cours des feuilles Outils Interactions Incidents Demandes Articles
   'depuis fichier Extraction_ServiceCenter_+date sous forme 31122008.xls
'c'est là que je coince..... Damned!!!   
   If Left(Classeur.Name, 24) = WbkES Then
  
  'copier la plage en cours des feuilles Template appels 1 à Template appels 3
  'depuis fichier ACD Template + date sous forme 1-2-3-mars.xls
   If Left(Classeur.Name, 13) = WbkTe Then
  
 Next X

Question 1 : faut-il obligatoirement ouvrir les 2 fichiers à copier?
Question 2 : le fichier vers lequel je recopie les données comporte après les colonnes à recopier des formules de calcul que je ne dois pas écraser, mais recopier vers le bas sur toute la hauteur de la plage
comment faire tout ça???

Merci immensément pour votre aide.

Big Bisous et bonne soiréche

C@thy

skoobi · 28 Avril 2009

Re : VBA j'y suis presque...

Bonsoir C@thy,

Question 1 : faut-il obligatoirement ouvrir les 2 fichiers à copier?

Non, une solution est d'utiliser GetObject, mais sous 2 condition:

que l'on veut uniquement "lire" dans le fichier
il faut absolument penser à le refermer à la fin

En bleu ce que ça donne, commentaire inclus 😉 (sans garantie car sans les fichiers, pas facile...):

Code:

For X = 1 To NbFichiers  'boucles sur les 2 classeurs
  For fl = 1 To 8
    Sheets(fl).Select
    Nomf = ActiveSheet.Name
    'copier la plage en cours des feuilles Outils Interactions Incidents Demandes Articles
    'depuis fichier Extraction_ServiceCenter_+date sous forme 31122008.xls
    'c'est là que je coince..... Damned!!!
    [B][COLOR=Blue]If Left(ListeClasseurs(X), 24) = WbkES Then
      Set Wb = GetObject(Chem & ListeClasseurs(X))
      'ici le copier/coller, par exemple la cellule A1 du fichier "ListeClasseurs" feuille 1 vers la feuille "fl" cellule A1:
      Wb.Sheets(1).Range("A1").Copy Sheets(fl).Range("A1")
      Wb.Close 'TRES IMPORTANT CAR SINON LE FICHIER NE POURRA ETRE OUVERT PAR LA SUITE[/COLOR][/B]
    End If

Question 2 : le fichier vers lequel je recopie les données comporte après les colonnes à recopier des formules de calcul que je ne dois pas écraser, mais recopier vers le bas sur toute la hauteur de la plage
comment faire tout ça???

Là sans les fichiers, mission impossible où alors explique dans les détails ce que tu veux.

Bonne soirée.

Edit: une remarque: pourquoi avoir créé le Tableau puisque les fichiers sont mis dans la collection ListeClasseurs?
Du cout,

Code:

NbFichiers = NbFichiers + 1

devient inutile également.

Edit2: déclare aussi Wb au début du code:

Code:

Dim Wb as WorkBook

C@thy · 28 Avril 2009

Re : VBA j'y suis presque...

Merci Skoobi doudou (on a du te la faire des milliers de fois celle-la!)
Encore une fois tu viens a mon secours.
Oui zeffectivement le +1 ne sert a rien.
Tu m'en apprends des choses! Penser a refermer un classeur qu'on n'a pas ouvert
C'est dingue!!! Un grand MERCI en tout cas.
Je teste ça 2min matin au boulot et je te dis ce qu'il en est.
Bibises et bon dodo.
C@thy

C@thy · 29 Avril 2009

Re : VBA j'y suis presque...

Coucou Skoobi, bonjour le forum,

Arf! je viens de m'apercevoir que je n'y étais pas presque, j'ai encore du boulot.
J'ai enlevé le +1 mais ça va pas, alors cette partie-là je laisse comme ça pour l'instant.
Pour le reste, je bidouille un truc dans mon coin et je reviens avec mes expériences... je l'aurai un jour!!!!

Biz et bonne journée

C@thy

C@thy · 29 Avril 2009

Re : VBA j'y suis presque...

Cette fois-ci, j'y suis presque,
il me manque juste un petit coup de pouce savamment dosé.

Voici mes fichiers.

Un énorme Merci pour votre aide.

Bises et bonne journée

C@thy

pierrejean · 29 Avril 2009

Re : VBA j'y suis presque...

bonjour C@thy

Salut Skoobi

Vois si cela va mieux

les modifs (en bleu)

Code:

[COLOR=blue]Selection.AutoFill Destination:=Range("X2:AJ" & DerniereLigne)
[/COLOR]     'Ici : ça marche pas A VOIR...
  Case 3
    WsS.Range("A:AI").Copy WsD.Range("A1")
    Application.CutCopyMode = False
    
  DerniereLigne = WsD.Range("B65535").End(xlUp).Row
 [COLOR=blue] 'DerniereLigne = "AJ2:AY" & DerniereLigne
[/COLOR]  WsD.Range("AJ3:AY65535").ClearContents ' ceci fonctionne
  WsD.Activate
  Range("AJ2:AY2").Select
 [COLOR=blue] Selection.AutoFill Destination:=Range("AJ2:AY" & DerniereLigne)
  [/COLOR]

C@thy · 29 Avril 2009

Re : VBA j'y suis presque...

Et hop! Déjà un problème de résolu!

Merci Pierrejean et gros bisous

C@thy

skoobi · 29 Avril 2009

Re : VBA j'y suis presque...

Re bonjour C@thy 🙂,
salut PierreJean 🙂,

C@thy à dit:
Merci Skoobi doudou (on a du te la faire des milliers de fois celle-la!)
C@thy

C'est après avoir créé le pseudo que je me suis dis, tiens, on va pas me loupé 😀.

Tu m'en apprends des choses! Penser a refermer un classeur qu'on n'a pas ouvert
C'est dingue!!! Un grand MERCI en tout cas.

En fait, le fichier est "chargé" dans une variable objet sans pouvoir être vu dans excel (un peu comme une macro complémentaire) mais malgré cela, si le Close n'est pas exécuté, il sera impossible d'ouvrir le fichier même après la fin de la macro, donc attention!!!.
Cependant il sera néanmoins possible d'appliqué le Close dans la fenêtre d'exécution au cas où (euuhh, tu me suis toujours là...)😉.

Voili voulou,

Signé Sk.... bidou bidoouuuoouuu 😀.

C@thy · 29 Avril 2009

Re : VBA j'y suis presque...

Youbidou bi dou wap!😛

Ah tout s'explique, je comprends mieux! Merciiiiiiiiii.🙂

Donc tu me disais :

une remarque: pourquoi avoir créé le Tableau puisque les fichiers sont mis dans la collection ListeClasseurs?

Oui, très bonne question, mais j'ai pas réussi à simplifier...🙁
(le fait que ça fonctionne est déjà pour moi un exploit!) 🙄

je me demandais si le fait de prendre les colonnes dans leur intégralité n'était pas trop lourd, et s'il ne valait pas mieux ouvrir le fichier et prendre la zone en cours (CurrentRegion).

Le fichier étant mastodontesque, j'ai intérêt à tout optimiser. 😉
J'accepte toute proposition (honnête...) dans ce sens. Lol!

Bizzz 😎

C@thy

skoobi · 29 Avril 2009

Re : VBA j'y suis presque...

Re,

je me demandais si le fait de prendre les colonnes dans leur intégralité n'était pas trop lourd, et s'il ne valait pas mieux ouvrir le fichier et prendre la zone en cours (CurrentRegion).

Trouver la dernière ligne suffit à identifier la plage.

Le fichier étant mastodontesque, j'ai intérêt à tout optimiser. 😉
J'accepte toute proposition (honnête...) dans ce sens. Lol!

J'ai simplifié la copie des formules.
J'ai commenté le code en y mettant "ma patte" 😀😛.
....et mis Application.CutCopyMode = False en commentaire vu que la copie se fait sur une seule ligne (le .Paste n'est pas utilisé).

Bon test et bonne soirée 🙂.

C@thy · 29 Avril 2009

Re : VBA j'y suis presque...

Yawohl!!! SuperNialgé, temps de réponse très rapide.
Voilà du bon boulot.
Un énorme MERCI et un gros poutou.

au fait, ce truc ne te plaisait pas trop :
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" And Classeur.Name <> ThisWorkbook.Name Then
If Left(Classeur.Name, 24) = WbkES Or Left(Classeur.Name, 13) = WbkTe Then
ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = cl
cl = Dir()
End If
End If
Next

tu pensais qu'il y avait des instructions inutiles...
En fait c'est le seul moyen que j'ai trouvé pour rechercher mes 2 fichiers, sachant que la fin de leur nom
change chaque mois, mais c'est peut-être pas la meilleure solution...

Question subsidiaire :
pendant ce temps-là je galère sur la suite, car ce serait pas drôle s'il n'y avait qu'une copie.

Ce qui est dans Dodo je dois le recopier dans un autre pour faire des TCD et tout ça.
(impossible de faire des liaisons car on ne fournit pas Dodo). Mais nos chers zutilisateurs ne doivent pas voir les formules de Dodo.
Donc du coup je me suis lancée dans un copier collage spécial valeurs en ouvrant Dodo,
mais peut-être y a-t-il une instruction pour récupérer les valeurs sans ouvri le classeur???
(ce que je fais est plutôt lourd!!!).
Si des fois tu connais l'instruction magique...

Bises et bonne soirée

C@thy

skoobi · 29 Avril 2009

Re : VBA j'y suis presque...

C@thy à dit:
Yawohl!!! SuperNialgé, temps de réponse très rapide.
Voilà du bon boulot.
Un énorme MERCI et un gros poutou.

au fait, ce truc ne te plaisait pas trop :
For Each Classeur In Fichiers
If Right(Classeur.Name, 3) = "xls" And Classeur.Name <> ThisWorkbook.Name Then
If Left(Classeur.Name, 24) = WbkES Or Left(Classeur.Name, 13) = WbkTe Then
ListeClasseurs.Add Classeur.Name
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = cl
cl = Dir()
End If
End If
Next

tu pensais qu'il y avait des instructions inutiles...
En fait c'est le seul moyen que j'ai trouvé pour rechercher mes 2 fichiers, sachant que la fin de leur nom
change chaque mois, mais c'est peut-être pas la meilleure solution...
C@thy

Il y a plusieurs façon de récupérer des fichiers et cette méthode en est un exemple parmi d'autre. Pour ce qui est "en trop", voici la modification à faire (en rouge ce que j'ai mis en commentaire, en bleu ce qu'il faut modifier):

Code:

  Set Fichiers = CreateObject("Scripting.FileSystemObject").getfolder(Chem).Files  'tous les classeurs du répertoire
  For Each Classeur In Fichiers
    If Right(Classeur.Name, 3) = "xls" And Classeur.Name <> ThisWorkbook.Name Then
      If Left(Classeur.Name, 24) = WbkES Or Left(Classeur.Name, 13) = WbkTe Then
        ListeClasseurs.Add Classeur.Name
[B][COLOR=Red]'        NbFichiers = NbFichiers + 1
'        ReDim Preserve Tableau(1 To NbFichiers)
'        Tableau(NbFichiers) = cl
'        cl = Dir()[/COLOR][/B]
      End If
    End If
  Next
  'classeur Dodo comporte 8 feuilles à remplir onglets 1 à 8
  'Outils Interactions Incidents Demandes Articles et Template appels 1 à Template appels 3
  For X = 1 To [COLOR=Blue][B]ListeClasseurs.Count[/B][/COLOR]  'boucles sur les 2 classeurs
......
...........

Question subsidiaire :
pendant ce temps-là je galère sur la suite, car ce serait pas drôle s'il n'y avait qu'une copie.

Ce qui est dans Dodo je dois le recopier dans un autre pour faire des TCD et tout ça.
(impossible de faire des liaisons car on ne fournit pas Dodo). Mais nos chers zutilisateurs ne doivent pas voir les formules de Dodo.
Donc du coup je me suis lancée dans un copier collage spécial valeurs en ouvrant Dodo,
mais peut-être y a-t-il une instruction pour récupérer les valeurs sans ouvri le classeur???
(ce que je fais est plutôt lourd!!!).
Si des fois tu connais l'instruction magique...

J'ai du mal à te suivre.
Tu copies des infos de 2 fichiers vers "Dodo" ok et ensuite copier uniquement les valeurs vers un autre fichier c'est çà?
Mais tu veux que "Dodo" soit fermé?
Dans ce cas le code pour copier uniquement les valeurs devra figuré dans le "3eme fichier".
Si je reprends un exemple du code actuel:

Code:

WsS.Range("A1:W" & DerniereLigne).Copy WsD.Range("A1")

Pour récupéré seulement le valeurs, voici la syntaxe:

Code:

WsD.Range([B]"A1:W" & DerniereLigne[/B]).Value = WsS.Range([B]"A1:W" & DerniereLigne[/B]).Value

La plage entre les 2 fichiers doit être exactement la même. Tu auras remarqué que la destination "passe à gauche".

C@thy · 30 Avril 2009

Re : VBA j'y suis presque...

Ah cette fois je tiens le bon bout.

Un grand MERCI pour ta gentillesse et ta patience.

Bon ouik (3 jours!!! 🙂 🙂 🙂)

Bises

C@thy

VBA j'y suis presque...

C@thy

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

C@thy

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

Pièces jointes

C@thy

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

Discussions similaires

VBA j'y suis presque...

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency