Copier les données en dessous de celles copier juste avant
Bonjour le forum !
Je cherche à récupérer des données de deux fichiers différents A et B (pour l'exemple il n'y en a que 2 en réalité il y en a 13).
J'arrive à copier les données de A mais je n'arrive pas à copier celles de B juste en dessous de la dernière ligne de cellules non vides.
Les données du fichier B se copient ) la ligne 13083.
Voici mon code :
Sub Bouton1_Cliquer()
Dim f As Long
Dim PremiereLigne As String
'Traitemnt du classeur A
Workbooks.Open "G:\ACE\essais macro\A.xlsx"
PremiereLigne = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("A.xlsx").Sheets("A").Range("B4:J" & PremiereLigne).Copy
Workbooks("ARCHIVES-BILAN.xlsm").Activate
Workbooks("ARCHIVES-BILAN.xlsm").Sheets("RECAP").Range("B3").Select
Workbooks("ARCHIVES-BILAN.xlsm").Sheets("RECAP").Paste
Workbooks("A.xlsx").Close
'Traitement du classeur B
Workbooks.Open "G:\ACE\essais macro\B.xlsx"
PremiereLigne = ActiveSheet.UsedRange.Rows.Count + 1
Workbooks("B.xlsx").Sheets("B").Range("B4:J" & PremiereLigne).Copy
Workbooks("ARCHIVES-BILAN.xlsm").Activate
Workbooks("ARCHIVES-BILAN.xlsm").Sheets("RECAP").Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select
Workbooks("ARCHIVES-BILAN.xlsm").Sheets("RECAP").Paste 'Effectue le collage
Workbooks("B.xlsx").Close
End Sub
Pouvez vous m'aider SVP ?
Merci d'avance
Bonjour
avec l'instruction "Workbooks("A.xlsx").Close"
je pense que vous stoppez la procédure,
j'essayerai "Workbooks("A.xlsx").Next"
C'est juste une idée, je n'y connais rien
Merci du conseil mais cela ne fonctionne pas non plus :/
En déclarant Dim deuxiemeLigne
et l'utiliser pour le classeur B peut être
Bonjour,
A priori ... tu vas avoir besoin d'une boucle ...
Dans un premier temps, tu pourrais tester la macro suivante :
Option Explicit
Sub Bouton1_Cliquer()
Dim fichierSource As Workbook
Dim fichierDestination As Workbook
Dim DerniereLigneSource As Long
Dim DerniereLigneDestination As Long
Dim arFichiers As Variant
Dim fichierindiv As Variant
arFichiers = Array("A", "B")
Set fichierDestination = ActiveWorkbook ' soit Workbooks("ARCHIVES-BILAN.xlsm")
For Each fichierindiv In arFichiers
'Traitement des classeurs A et B
DerniereLigneDestination = fichierDestination.Sheets("RECAP").Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
Workbooks.Open "G:\ACE\essais macro\" & fichierindiv & ".xlsx"
Set fichierSource = ActiveWorkbook
DerniereLigneSource = fichierSource.ActiveSheet.Cells(Application.Rows.Count, "B").End(xlUp).Row
fichierDestination.Sheets("RECAP").Range("B" & DerniereLigneDestination).Value = fichierSource.Sheets("A").Range("B4:J" & DerniereLigneSource).Value
fichierSource.Close
Next fichierindiv
End Sub
En espérant que cela t'aide
Bonjour,
Une piste avec ton exemple.
Quand on travaille sur plusieurs classeurs, il est fortement conseillé d'utiliser des variables Objet "Workbook". Plutôt que de Copier/Coller, je préfère l'affectation des valeurs car ça évite d'embarquer tout et n'importe quoi.
Je te conseille fortement d'abandonner l'utilisation de UsedRange car tu peux avoir des surprises sur les valeurs retournées (ici, la valeur de la propriété Rows.Count). Pour que tu comprennes ce que je veux dire, testes le code ci-dessous sur une feuille contenant quelques valeurs :
Sub Test()
Dim Lig As Long
With ActiveSheet
'ici, le code retourne la dernière ligne ayant une valeur si on ne sais pas dans quelle colonne elle se trouve
Lig = .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column).Row
MsgBox Lig
'on ne fait que formater la cellule qui se trouve 10 lignes au dessous
'en colonne A sans la remplir, juste en la formatant en gras
.Cells(Lig + 10, 1).Font.Bold = True
'et on appelle UsedRange qui, d'après ce qu'on espère, devrait retourner
'la même valeur que précédemment puisque pas de valeur entrée dans une autre cellule
'mais là, surprise !
MsgBox .UsedRange.Rows.Count
End With
End Sub
Si tu dois ouvrir plusieurs classeurs, il te faudra faire une boucle :
Sub Bouton1_Cliquer()
Dim Cls As Workbook
Dim ClsArchives As Workbook
Dim LigCls As Long
Dim LigArchive As Long
Set ClsArchives = ThisWorkbook 'ou Workbooks("ARCHIVES-BILAN.xlsm") car je suppose que c'est dans ce dernier que se trouve ce code !
'Traitemnt du classeur A
Set Cls = Workbooks.Open("G:\ACE\essais macro\A.xlsx")
With Cls.Worksheets("A")
'il est préférable de ne pas utiliser UsedRange afin d'éviter les mauvaises surprises (voir la proc Test !)
LigCls = .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column).Row
ClsArchives.Sheets("RECAP").Range("B3:J" & LigCls - 1).Value = .Range("B4:J" & LigCls).Value
End With
Cls.Close
With ClsArchives.Sheets("RECAP")
LigArchive = .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column).Row + 1
End With
'Traitement du classeur B
Set Cls = Workbooks.Open("G:\ACE\essais macro\B.xlsx")
With Cls.Worksheets("B")
LigCls = .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column).Row
ClsArchives.Sheets("RECAP").Range("B" & LigArchive & ":J" & LigArchive + LigCls - 4).Value = .Range("B4:J" & LigCls).Value
End With
Cls.Close
End Sub
Oups,
Désolé James, pas rafraîchi !
Merci Theze et James007, effectivement ça fonctionne !
Merci beaucoup !