copie plage de données d'un classeur à un autre

empires

XLDnaute Nouveau
Bonjour à la communauté

Je voudrais automatiser par des macros la copie de plage de cellules du classeur stats_global1 vers le classeur statana dans l'onglet stats_1.

J'ai créé une macro dans le classeur stats_global1 ( Transfert vers statana) mais elle fonctionne à moitié :
elle copie que le nom des villes et le mois .

Habituellement j'alimente le classeur en mode manuel :

copie des données de stats_1 du classseur stats_global à partir de la colonne E ( code) du classeur statana
saisie manuelle dans la colonne A ( site) du nom de la ville
saisie manuelle dans la colonne B ( Année) de l'année
saisie manuelle dans la colonne C ( Mois) du mois

Ces 3 saisies manuelles , je les fais sur 2 lignes ensuite je tire ces 2 lignes jusqu'à la dernière ligne ou s'est arrêté la copie des données des stats_1 du classeur stats_global.
Et enfin je tire sur la colonne E ( Automate ) pour que ma formule RechercheV s'actualise

En pièce jointe mes classeurs
 

Pièces jointes

  • statana.xlsx
    115.2 KB · Affichages: 26
  • stats_global1.xlsm
    38 KB · Affichages: 35

camarchepas

XLDnaute Barbatruc
Re : copie plage de données d'un classeur à un autre

Bonjour Empires,

Tu peux nous faire cela au ralenti.
Car ton code n'est vraiment pas adapté en effet .
Pour mieux comprendre pourrais-tu mettre en mode enregistrement.

faire la manip , y compris le renseignement manuel ,arrêter l'enregistrement , et me renvoyer le fichier contenant la macro enregistré

ensuite , il ne restera plus qu'a supprimer, paramétrer et fiabiliser le résultat .
 

empires

XLDnaute Nouveau
Re : copie plage de données d'un classeur à un autre

Bonjour camarchepas

Ok

1éme étape
Ouverture de statana

Sub Transfert()

Windows("statana.xlsx").Activate
Range("A1").End(xlDown).Offset(1).Select
ActiveCell = "Ville1"
ActiveCell.Offset(0, 1).Select
ActiveCell = "2014"
Range("A1").End(xlDown).Offset(1).Select
ActiveCell = "Ville1"
ActiveCell.Offset(0, 1).Select
ActiveCell = "2014"
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(0, 1).Select
ActiveCell = "juillet"
ActiveCell.Offset(1, 0).Select
ActiveCell = "juillet"
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(0, 1).Select
' saisie de la ville , du mois et de l'année sur 2 lignes ( colonne A à C )

2eme étape
selection du classeur stats_global et selection des cellules de l'onglet 1 et copie dans le classeur statana à la colonne E

Windows("stats_global1.xlsm").Activate
Sheets("stats_1").Select
Range("A1").End(xlDown).Offset(1).Select
copy = Columns("A:C").Cells.SpecialCells(xlCellTypeConstants, 23).Select
selection.copy
Windows("statana.xlsx").Activate
Range("A1").End(xlDown).Offset(1).Select
ActiveCell.Offset(-2, 4).Select
ActiveSheet.Paste
' cette étape ne fonctionne pas !!!!

Voilà , une fois cela réglé j'exposerais la suite , car sinon je vais être brouillon dans mes explications

merci de ton aide
 
Dernière édition:

camarchepas

XLDnaute Barbatruc
Re : copie plage de données d'un classeur à un autre

Oui,

Mais ça j'avais déjà vu ,

Sais-tu enregistrer une macro dans le menu developpeur : Enregistrer une macro .

Car ce que tu m'envoyes , c'est déjà un code écrit par toi , en non pas brute de l'enregistreur et c'est pas ce qui m'aide.
 

empires

XLDnaute Nouveau
Re : copie plage de données d'un classeur à un autre

voila via l'enregistreur
Sub Macro1()
'
' Macro1 Macro
'


Range("A1:C276").Select
selection.copy ' du classeur stats_globals

Windows("statana.xlsx").Activate
Range("E473").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A473").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Ville1"
Range("A474").Select
ActiveCell.FormulaR1C1 = "Ville1"
Range("B473").Select
ActiveCell.FormulaR1C1 = "2014"
Range("B474").Select
ActiveCell.FormulaR1C1 = "2014"
Range("C473").Select
ActiveCell.FormulaR1C1 = "Juillet"
Range("C474").Select
ActiveCell.FormulaR1C1 = "Juillet"
Range("D471:D472").Select
selection.AutoFill Destination:=Range("D471:D474"), Type:=xlFillDefault
Range("D471:D474").Select
Range("A473:D474").Select
selection.AutoFill Destination:=Range("A473:D748")
Range("A473:D748").Select
ActiveWindow.SmallScroll Down:=21
End Sub
 

camarchepas

XLDnaute Barbatruc
Re : copie plage de données d'un classeur à un autre

Voici donc pour la premiére partie

Comme je sais pas comment déduire Ville, Année et mois , pour le moment c'est 3 inputbox qui vont te demander.


Code:
Sub Copie()
Dim Fin_Source As Long, Debut_Cible As Long, Fin_Cible As Long
Dim Ville As String, Année As String, Mois As String
Fin_Source = ThisWorkbook.Worksheets("stats_1").Range("A" & Rows.Count).End(xlUp).Row
Debut_Cible = ThisWorkbook.Worksheets("stats_1").Range("A" & Rows.Count).End(xlUp).Row
villes:
Ville = InputBox("Entrez la ville : ")
If Ville = "" Then GoTo villes
Années:
Année = InputBox("Entrez l'année : ")
If Année = "" Then GoTo Années
moiss:
Mois = InputBox("Entrez le mois :")
If Mois = "" Then GoTo moiss

With Workbooks("statana.xlsx").Sheets("stats")
Debut_Cible = .Range("A" & Rows.Count).End(xlUp).Row + 1
Fin_Cible = Fin_Source + Debut_Cible - 1
  ThisWorkbook.Worksheets("stats_1").Range("A1:C" & Fin_Source).copy Destination:=.Range("E" & Debut_Cible)
  .Range("A" & Debut_Cible & ":A" & Fin_Cible) = Ville
  .Range("B" & Debut_Cible & ":B" & Fin_Cible) = Année
  .Range("C" & Debut_Cible & ":C" & Fin_Cible) = Mois
End With

End Sub
 

camarchepas

XLDnaute Barbatruc
Re : copie plage de données d'un classeur à un autre

Bonjour Empires ,

Attention ligne 8 =#NOM? , j'ai du prévoir une sécurité pour éviter le plantage , mais en aucun cas tu ne trouveras cette référence

Voilà donc la carte des desserts : (Oups , plus de formules à tirer , dommage , non , pas de regrets ... ok on y va)
Ah oui pour le moment si pas trouvé , je n'affiche rien , veux tu renseigner quelque chose dans la case ou pas , être alerté par un message .(La il risque d'y en avoir beaucoup (Une vraie usine à popup))

Allez , revoici le code complété et trés légérement modifié

Code:
Option Explicit

Sub Copie()
Dim Fin_Source As Long, Debut_Cible As Long, Fin_Cible As Long, Tourne As Long
Dim Ville As String, Année As String, Mois As String
Dim Trouve As Range
Fin_Source = ThisWorkbook.Worksheets("stats_1").Range("A" & Rows.Count).End(xlUp).Row
Debut_Cible = ThisWorkbook.Worksheets("stats_1").Range("A" & Rows.Count).End(xlUp).Row
villes:
Ville = InputBox("Entrez la ville : ")
If Ville = "" Then GoTo villes
Années:
Année = InputBox("Entrez l'année : ")
If Année = "" Then GoTo Années
moiss:
Mois = InputBox("Entrez le mois :")
If Mois = "" Then GoTo moiss

With Workbooks("statana.xlsx") ' délimite l'environnement au classeur Statana
 
 With .Sheets("stats") 'Délimite l'environnement à la feuile stats (Chaque info commençant par un point non résolu se rapporte à cet environnement)
   Debut_Cible = .Range("A" & Rows.Count).End(xlUp).Row + 1
   Fin_Cible = Fin_Source + Debut_Cible - 1
   ThisWorkbook.Worksheets("stats_1").Range("A1:C" & Fin_Source).copy Destination:=.Range("E" & Debut_Cible)
   .Range("A" & Debut_Cible & ":A" & Fin_Cible) = Ville
   .Range("B" & Debut_Cible & ":B" & Fin_Cible) = Année
   .Range("C" & Debut_Cible & ":C" & Fin_Cible) = Mois
 End With 'Fin de l'environnement Feuille stats
 
 'Recherche du code
  For Tourne = Debut_Cible To Fin_Cible
   Set Trouve = .Sheets("liste ana auto").Range("A:A").Find(CStr(.Sheets("stats").Range("e" & Tourne)), lookat:=xlWhole)
  'test si résultat
   If Not Trouve Is Nothing Then .Worksheets("stats").Range("D" & Tourne) = .Worksheets("liste ana auto").Range("C" & Trouve.Row).Text
  Next Tourne
End With
End Sub
 

camarchepas

XLDnaute Barbatruc
Re : copie plage de données d'un classeur à un autre

Si tu as écris le code comme je te l'ai proposé, tu restes dans la boucle infernale tant que tu n'as pas renseigné la ville.

Que voudrais tu qu'il fasse d'autre si ce n'est pas l'action attendue.
 

Membres actuellement en ligne

Statistiques des forums

Discussions
287 536
Messages
1 884 452
Membres
163 314
dernier inscrit
cedric.remacle
Haut Bas