macro pour copier des données d'un fichier à l'autre - problème Rows(nouvelle.ligne)

AL_25

XLDnaute Nouveau
Bonjour,

Tout d'abord, je débute en macro et ne comprends que partiellement ce que je fais et vous remercie d'avance pour votre aide.

J'essaie de créer un fichier Excel avec macro qui va copier des données mensuelles dans un tableau de récap annuel.
Un fichier Excel est créé par mois (ce sont des données extraites d'un programme salaires).

Le fichier annuel est un "simple" listing des données mensuelles. Elles s'ajoutent mois par mois les unes en dessous des autres et ont toujours la même structure.

Voici la macro:
'Mémoriser les noms de fihciers et de feuilles
Sub recup_donnees_CIP()
fichier_mensuel = Cells(12, 3)
feuille_mensuel = Cells(16, 3)
fichier_annuel = ActiveWorkbook.Name
feuille_annuel = "CIP" 'si la feuille est renommée, à changer

'Copier/coller valeurs des lignes déjà existantes
Sheets(feuille_annuel).Select
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Le nouveau mois à charger est le dernier mois +1, lu en colonne A = colonne 1
Range("B2").Select
Selection.End(xlDown).Select
nouvelle_ligne = Selection.Row + 1
nouveau_mois = Cells(Selection.Row, 1) + 1

'Lire les lignes à copier
Workbooks(fichier_mensuel).Worksheets(feuille_mensuel).Activate
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
nombre_nouv_lignes = Selection.Rows.Count
Selection.Copy

'Insérer les nouvelles lignes
Workbooks(fichier_annuel).Worksheets(feuille_annuel).Activate
Rows(nouvelle_ligne).Select
Selection.Insert Shift:=xlDown

'Ajouter le mois
Range(Cells(nouvelle_linge, 1), Cells(nouvelle_ligne + nombre_nouv_ligne - 1, 1)) = nouveau_mois

'Lire les données à copier et les copier
Workbooks(fichier_mensuel).Worksheets(feuille_mensuel).Activate
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
nombre_nouv_lignes = Selection.Rows.Count
Selection.Copy


End Sub

Elle bloque à cet endroit là et je ne comprends pas pourquoi. Je l'ai déjà utilisée dans un autre fichier et elle fonctionne.

Merci d'avance pour votre aide!!!!!!!!!!
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Pas évident de tester sans fichier exemple
Peux-tu redire si ta macro ainsi modifiée donne le même résultat ?
VB:
Sub recup_donnees_CIP_B()
fichier_mensuel = Cells(12, 3)
feuille_mensuel = Cells(16, 3)
fichier_annuel = ActiveWorkbook.Name
feuille_annuel = "CIP" 'si la feuille est renommée, à changer
'Copier/coller valeurs des lignes déjà existantes
Sheets(feuille_annuel).UsedRange.Value = Sheets(feuille_annuel).UsedRange.Value
'Le nouveau mois à charger est le dernier mois +1, lu en colonne A = colonne 1
nouvelle_ligne = Cells(Rows.Count, "B").End(3)(2).Row
nouveau_mois = Cells(nouvelle_ligne - 1, "A") + 1
''Lire les lignes à copier
With Workbooks(fichier_mensuel).Worksheets(feuille_mensuel)
Set r = Range(.Rows(2), .Rows(2).End(xlDown))
nombre_nouv_lignes = r.Rows.Count
r.Copy
End With
''Insérer les nouvelles lignes
Workbooks(fichier_annuel).Worksheets(feuille_annuel).Rows(nouvelle_ligne).Insert Shift:=xlDown
'///// J'ai arrêté mes modifs ici
''Ajouter le mois
'Range(Cells(nouvelle_ligne, 1), Cells(nouvelle_ligne + nombre_nouv_ligne - 1, 1)) = nouveau_mois
''Lire les données à copier et les copier
'Workbooks(fichier_mensuel).Worksheets(feuille_mensuel).Activate
'Rows(2).Select
'Range(Selection, Selection.End(xlDown)).Select
'nombre_nouv_lignes = Selection.Rows.Count
'Selection.Copy
End Sub
PS: Pour info, Il y a une coquille dans ton code : linge au lieu de ligne ;)
'Ajouter le mois
Range(Cells(nouvelle_linge, 1), Cells(nouvelle_ligne + nombre_nouv_ligne - 1, 1)) = nouveau_mois
 

AL_25

XLDnaute Nouveau
Hello!

Merci pour la réponse et pour ton aide.

Il y a toujours un couac dans la macro. Voici les fichiers.

Le fichier de contrôle est celui dans lequel il y a la macro. L'autre est celui à importer.
 

Pièces jointes

  • 2019_Contrôle CIP_2.xlsm
    47.3 KB · Affichages: 16
  • Fichier test.xlsx
    10.5 KB · Affichages: 9

Staple1600

XLDnaute Barbatruc
Re

A défaut de chocolats (et même si VBA ne connait pas Paques;))
J'ai testé ceci sur tes fichiers exemples
(et si je publie ce code, c'est donc que le test est OK sur mon PC)
VB:
Sub recup_donnees_CIP_C()
Dim wsA As Worksheet, wsB As Worksheet
Dim fichier_mensuel$, feuille_mensuel$, fichier_annuel$
fichier_mensuel = Feuil1.Cells(12, 3)
feuille_mensuel = Feuil1.Cells(16, 3)
fichier_annuel = ActiveWorkbook.Name
feuille_annuel = "CIP" 'si la feuille est renommée, à changer
'Copier/coller valeurs des lignes déjà existantes
Sheets(feuille_annuel).UsedRange.Value = Sheets(feuille_annuel).UsedRange.Value
'Lire les lignes à copier
Set wsA = Workbooks(fichier_mensuel).Worksheets(feuille_mensuel)
Set wsB = Workbooks(fichier_annuel).Worksheets(feuille_annuel)
'Insérer les nouvelles lignes
wsA.[A1].CurrentRegion.Offset(1).Copy wsB.Cells(Rows.Count, "B").End(3)(2)
Application.CutCopyMode = False
'///// J'ai arrêté mes modifs ici
End Sub
 

AL_25

XLDnaute Nouveau
Bonsoir

AL_25
Pour que l'envie me vienne de répondre un peu plus, il eut peut-être fallu que je trouve trace du code VBA que je t'ai proposé dans ta PJ...
Or que nenni, nada, queue de chique ;)

Hello!

Merci pour tes réponses!

Et désolée pour le code.

J'avais essayé de l'intégrer et cela ne fonctionnait pas. J'ai oublié de le mentionner dans mon message précédent.
 

AL_25

XLDnaute Nouveau
Re

A défaut de chocolats (et même si VBA ne connait pas Paques;))
J'ai testé ceci sur tes fichiers exemples
(et si je publie ce code, c'est donc que le test est OK sur mon PC)
VB:
Sub recup_donnees_CIP_C()
Dim wsA As Worksheet, wsB As Worksheet
Dim fichier_mensuel$, feuille_mensuel$, fichier_annuel$
fichier_mensuel = Feuil1.Cells(12, 3)
feuille_mensuel = Feuil1.Cells(16, 3)
fichier_annuel = ActiveWorkbook.Name
feuille_annuel = "CIP" 'si la feuille est renommée, à changer
'Copier/coller valeurs des lignes déjà existantes
Sheets(feuille_annuel).UsedRange.Value = Sheets(feuille_annuel).UsedRange.Value
'Lire les lignes à copier
Set wsA = Workbooks(fichier_mensuel).Worksheets(feuille_mensuel)
Set wsB = Workbooks(fichier_annuel).Worksheets(feuille_annuel)
'Insérer les nouvelles lignes
wsA.[A1].CurrentRegion.Offset(1).Copy wsB.Cells(Rows.Count, "B").End(3)(2)
Application.CutCopyMode = False
'///// J'ai arrêté mes modifs ici
End Sub

Ton code fonctionne parfaitement! Merci!!!

Par contre, il plante dès que tu t'es arrêté:
'Ajouter le mois
Range(Cells(nouvelle_ligne, 1), Cells(nouvelle_ligne + nombre_nouv_ligne - 1, 1)) = nouveau_mois

'Lire les données à copier et les copier
Workbooks(fichier_mensuel).Worksheets(feuille_mensuel).Activate
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
nombre_nouv_lignes = Selection.Rows.Count
Selection.Copy
 

Staple1600

XLDnaute Barbatruc
Re

C'est logique, non?
Ce que j'ai modifié avec mes petits doigts fonctionnent (puisque je l'ai testé avant de le poster)
Le reste étant ton code original non modifié, donc sans rapport syntaxique avec le mien, Excel bronche ;)
Le principal n'est pas qu'il fonctionne (mon code) mais que tu ais compris ma syntaxe ;)
Pour ensuite, sur ta lancée , continuer les modifications.
 

AL_25

XLDnaute Nouveau
Hello!

Oui, tu as totalement raison :)

Alors, je commence à comprendre l'idée! Mais je n'arrive pas au bout :-(

Voici la fin du code que j'ai modifié:
Ajouter le mois
wsB.Activate
Range(Cells(nouvelle_ligne, 1), Cells(nouvelle_ligne + nombre_nouv_ligne - 1, 1)) = nouveau_mois

'Lire les données à copier et les copier
wsA.Activate
Rows(2).Select
Range(Selection, Selection.End(xlDown)).Select
nombre_nouv_lignes = Selection.Rows.Count
Selection.Copy

La partie en vert, je ne vois pas comment la modifier pour l'intégrer à ton code. Et j'ai beau chercher, je ne comprends pas et ne trouve pas de solution.

Si j'enlève cette partie, le code fonctionne parfaitement et je t'en remercie infiniment!

Dernière question: quand la macro se termine, je me retrouve tout en bas du fichier Excel (onglet Macro), est-ce que tu sais pourquoi?

Après, promis, je te laisse tranquille! :)
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Si j'étais moi, je joindrais un nouveau fichier Controle CIP avec deux onglets
un onglet A avant exécution macro
un onglet B après exécution macro (que j'aurais fait manuellement)
Et si j'étais moi, j'ajouterai détails et explications dans les commentaires du VBA
Et en fin si j'étais sur d'être moi et que cette question était la mienne, je relirais le fil en me demandant pourquoi je persiste à utiliser des Select et Activate quand on remarque que le répondeur (oui je parle de moi à la 3ième personne) s'échine à les éviter et/ou éviter ;)
 

AL_25

XLDnaute Nouveau
Merci pour les aiguillages!

Voici le résultat comme demandé.

Mais je n'arrive pas à ajouter le numéro de mois. J'ai ajouté des commentaires dans l'onglet "résultat voulu".

Merci d'avance.
 

Pièces jointes

  • 2019_Contrôle CIP_2.xlsm
    49.3 KB · Affichages: 18
  • Fichier test.xlsx
    11.7 KB · Affichages: 15

Staple1600

XLDnaute Barbatruc
Bonjour

Avec cette nouvelle macro, on se rapproche de ce que tu veux, non?
VB:
Sub recup_donnees_CIP_II()
Dim wsA As Worksheet, wsB As Worksheet, Lig&
Dim fichier_mensuel$, feuille_mensuel$, fichier_annuel$
fichier_mensuel = Cells(12, 3)
feuille_mensuel = Cells(16, 3)
fichier_annuel = ActiveWorkbook.Name
feuille_annuel = "CIP" 'si la feuille est renommée, à changer
'Copier/coller valeurs des lignes déjà existantes
Sheets(feuille_annuel).UsedRange.Value = Sheets(feuille_annuel).UsedRange.Value
'Lire les lignes à copier
Set wsA = Workbooks(fichier_mensuel).Worksheets(feuille_mensuel)
Set wsB = Workbooks(fichier_annuel).Worksheets(feuille_annuel)
'Insérer les nouvelles lignes
wsA.[A1].CurrentRegion.Offset(1).Copy wsB.Cells(Rows.Count, "B").End(3)(2)
Application.CutCopyMode = False
Lig = wsB.Cells(Rows.Count, "B").End(3).Row
With wsB.Range("A2:A" & Lig)
.FormulaR1C1 = "=RIGHT(RC[1],2)*1"
.Value = .Value
End With
End Sub
 

Discussions similaires

Réponses
3
Affichages
547
Réponses
2
Affichages
701

Statistiques des forums

Discussions
311 711
Messages
2 081 796
Membres
101 817
dernier inscrit
carvajal