Transfert classeur "père" > classeur "fils" (VBA)

[nounbxl76]

Bonjour le forum,

Je viens une nouvelle fois vers vous car j'ai un gros problème à gérer… Il y a quelques temps, j'avais mis au point une base Excel qui me permettait de faire un suivi d'évènements… Aujourd'hui, mon boss a décidé de virer mon suivi "manuel" et a implémenté une base de données (http)... seulement, il me demande toujours de faire des indicateurs sur les évènements donc obligation de passer par Excel… Mon problème est donc simple… A partir d'une extraction de la base (fichier Excel) que j'appellerai "classeur fils", je souhaite alimenter un autre classeur que j'appellerai "classeur père". La procédure de rapatriement des données devant être réalisée à partir du "classeur père". Par ailleurs, avant d'être rapatriées, les données du "classeur fils" devront subir une petite beauté…
Ci-joint se trouvent les 2 classeurs pour plus de détails…
Pour le classeur fils, j'ai décortiqué ce qu'il doit subir sous forme de 3 onglets (avant modifications > modifications > après modification).
Pour le classeur père, j'ai mis avant/après.
A noter que cette procédure sera lancée tous les jours donc il faudra supprimer les données importées de la veille (supprimer les filtres + clearcontents)

Je ne sais pas si j'ai été très clair alors merci par avance à ceux qui se pencheront sur ce sujet.

Cordialement,

 

[Compte Supprimé 979]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Bonsoir nounbxl76

Ce forum n'est pas là pour faire le boulot à la place des autres , mais pour aider dans le code.

Alors merci de lancer l'enregistreur de macro, d'effectuer tes manipulations et de nettoyer ton code

Ensuite si tu veux l'optimiser, nous sommes là

A+

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Tout à fait d'accord... Je me suis dit la même chose après avoir posté... Je me penche sur la question ces jours prochains et reviendrais vers le forum !
Bonne journée!

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Re,

J'ai essayé par mes propres moyens et notamment via l'info mise à disposition par (l'excellent) M. Boisgontier mais rien n'y fait... Je précise que les 2 fichiers sont dans le même répertoire.
Je joins les nouveaux fichiers au cas où...

Cordialement,

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Petite avancée... c'était logique que "ça ne marchait pas"... la macro prennait également les données du classeur père qui était vide... Il me reste maintenant à voir comment faire pour copier jusqu'à la dernière ligne trouvée et supprimer les données que je ne voulais pas récupérer du classeur fils (champs en rouge).

 

[Compte Supprimé 979]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Re,

Il me reste maintenant à voir comment faire pour copier jusqu'à la dernière ligne trouvée

Si ta colonne A est une colonne qui contient systématiquement des données
La dernière ligne remplie est

DerLig = Range("A" & Rows.Count).End(XlUp).Row

A+

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Bonjour,

Grâce au code ci-dessous, j'arrive pratiquement à ce que je veux et je suis super content... seul hic, je ne souhaitais pas transférer toutes les colonnes du classeur fils et surtout ne pas les transférer dans l'ordre...
Comment puis-je faire pour arriver à l'exemple du classeur père en introduction?
C'est à dire...
colonne A du père = colonne A du fils
colonne B du père = colonne D du fils
colonne C du père = colonne I du fils
colonne D du père = colonne E du fils
colonne E du père = colonne B du fils
colonne F du père = colonne C du fils
colonne G du père = colonne F du fils
colonne H du père = colonne H du fils
colonne I du père = colonne G du fils

Voici le code que j'ai déjà

Sub tsfr()

    Dim ligfin As Long
    Dim derlig As Long
    Dim i As Long
        
    Application.DisplayAlerts = False   'arrêt affichage
    Application.ScreenUpdating = False
           
    ChDir ThisWorkbook.Path ' Répertoire application
    ClassActuel = ThisWorkbook.Name
        
    Windows(ClassActuel).Activate
    Sheets("Avant").Activate
    
    On Error Resume Next    'retrait des filtres
    ActiveSheet.ShowAllData
    
    Range("A17:I65000").ClearContents   'efface les anciennes données
    Range("A17").Select
    nf = Dir("TW*.xls")

    Workbooks.Open Filename:=nf, ReadOnly:=True

    ligfin = Range("A" & Rows.Count).End(xlUp).Row
    Sheets(1).Range("A1:N" & ligfin).Copy
    Windows(ClassActuel).Activate
    Sheets("Avant").Select
    Range("A17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Workbooks(nf).Close savechanges:=False
    
    Range("A17").Select

    With Sheets("Avant")
        .Activate
        .[A16].Sort Key1:=Sheets("Avant").[A17], Order1:=xlAscending, Header:=xlGuess 'tri
        
        derlig = Range("A" & Rows.Count).End(xlUp).Row
        For i = derlig To 17 Step -1
        If Not IsNumeric(Cells(i, 1)) Then Rows(i).EntireRow.Delete
        Next i
    End With
    
    Application.DisplayAlerts = True    'remise en route affichage
    Application.ScreenUpdating = True

End Sub

Merci pour votre aide.

Cordialement

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Bonsoir,

Après avoir passé cet après-midi pluvieux à potasser sur le sujet et à tester différentes combinaisons... je n'arrive toujours pas au résultat escompté (cf. post précédent) ... Quelqu'un pourrait-il me venir en aide SVP?

Cordialement,

 

[Compte Supprimé 979]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Bonsoir Nounbxl76

Voici ton code modifié

Sub tsfr()
  Dim LigFin As Long, DerLig As Long
  Dim i As Long, nf As String
  Dim ShtFils As Worksheet, ShtPère As Worksheet
  Dim Inc As Integer, TabColS() As String, TabColD() As String
  '
  Application.DisplayAlerts = False  ' Désactiver les alertes Excel
  Application.ScreenUpdating = False  ' Désactiver le rafraichissement d'écran
  ' Définir les tableaux des colonnes sources vers celles de destinations
  TabColS = Split("A,B,C,D,E,F,G,H,I", ",")
  TabColD = Split("A,D,I,E,B,C,F,H,G", ",")
  ' Définir la feuille de destination du classeur père
  Set ShtPère = ThisWorkbook.Sheets("Avant")
  ' Afficher toutes les données et les effacer
  On Error Resume Next  ' En cas d'erreur on continue
  With ShtPère
    .ShowAllData
    .Range("A17:I65000").ClearContents   'efface les anciennes données
  End With
  On Error GoTo 0  ' Remettre la gestion d'erreur à la normal
  ' Récupérer le nom entier du fichier
  nf = Dir(ThisWorkbook.Path & "\TW*.xls")
  ' Ouvrir le fichier
  Workbooks.Open Filename:=nf, ReadOnly:=True
  ' Définir la feuille source
  Set ShtFils = ActiveWorkbook.Sheets(1)
  ' Trouver la ligne de fin
  LigFin = ShtFils.Range("A" & Rows.Count).End(xlUp).Row
  ' Activer ce classeur
  ShtPère.Activate
  ' Copier chaque plage indépendamment
  For Inc = 0 To 8
    ShtFils.Range(TabColS(Inc) & "5:" & TabColS(Inc) & LigFin).Copy
    ShtPère.Range(TabColD(Inc) & "17").PasteSpecial Paste:=xlPasteValues
  Next Inc
  ' Fermer le classeur fils
  Workbooks(nf).Close savechanges:=False
  ' Avec le classeur père
  With ShtPère
    .[A16].Sort Key1:=Sheets("Avant").[A17], Order1:=xlAscending, Header:=xlGuess  'tri
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = DerLig To 17 Step -1
      If Not IsNumeric(Cells(i, 1)) Then Rows(i).EntireRow.Delete
    Next i
  End With
  Application.DisplayAlerts = True  ' Réactiver les alertes
  Application.ScreenUpdating = True  ' Réactiver le rafraichissement
End Sub

A+

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Bonsoir,

Je m'étais emmêler les pinceaux sur les colonnes reprendre du fils vers le père alors j'ai réajusté le tir sur la commande Split (entièrement ma faute)... et le résultat est tout simplement énorme... Merci pour ton soutien BrunoM45... franchement super !!!

Bonne soirée et bonnes fêtes de fin d'année !

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Re,

J'ai un petit problème avec le code... il y a un petit bug car il ne trouve plus le fichier fils censé s'ouvrir avec

' Récupérer le nom entier du fichier
 nf = Dir(ThisWorkbook.Path & "\TW*.xls")
  ' Ouvrir le fichier
 Workbooks.Open Filename:=nf, ReadOnly:=True

Je n'ai pas modifié l'emplacement de ce fichier fils donc je ne vois pas trop...

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Re,

Je viens de remarquer que le bug vient de la sorte:
- 1er import du fils vers le père >>> OK
- ouverture du fils plus modifs (suppression de lignes par exemple)
- 2e import du fils vers le père >>> bug
La modifs du fils semble être à l'origine du problème...

 

[Compte Supprimé 979]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Re,

Le problème vient certainement de l'utilisation de l'intruction : ThisWorkbook.Path

Si tu ouvres le fichier Père depuis Excel, pas de soucis (normalement)
Si tu ouvres le fichier depuis l'explorateur = bug

A tester

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Le problème apparait dans les 2 cas.
En ce qui concerne, le changement de format de la date, ça ne fonctionne pas (colonne à convertir dans le fils = colonne D qui sera la colonne F du père).
Au cas où, je joins à nouveau les 2 fichiers

 

[nounbxl76]

Re : Transfert classeur "père" > classeur "fils" (VBA)

Rectificatif... l'ouverture du fichier depuis Excel ne plante pas la macro...
J'avais cliqué dans les fichiers récents lors de mon précédent test.