copie de feuilles excel dans un nouveau classeur

[floune]

Bonjour à tous,

J'ai un problème à vous exposer :

J'ai plusieurs classeurs identiques (toto, titi, tata, etc) avec 12 feuilles dans chaque (qui sont les mois de l'année)
Je voudrais recopier les différentes feuilles du mois d'avril par exemple dans un nouveau classeur (transfert.xls)
Mais j'ai un souci supplémentaire
dans mes classeurs d'origine, j'ai une cellule A1 qui contient le nom de la personne concerné.

classeurs toto, titi, tata...
A1= nom, Prénom
A2 à AH4 = Entête
A5 à A48 = date que je veux recopier
B5 à Ah48 = données que je veux recopier
évidemment je ne veux que les lignes où il y a quelque chose

classeur Transfert
A2 à AH4 = Toujours entête mais qui est déjà faite (donc je n'ai pas besoin de la recopier)
A5 à A48 = date (cellules A5 à A48 des précédents classeurs)
b5 à b48 = Nom (cellule A1 des précédents classeurs)
c5 à ai48 = données (cellules B5 à ah48 des précédents classeurs)
Sur la première ligne de ce classeur transfert, j'ai un bouton transfert de données.


merci de votre réponse

 

[floune]

personne ne peut m'aider

 

[tom]

Bonsoir Floune,

peut-être pourrais tu nous joindre en zip un format de ton classeur, cela nous ferait gagner du temps....

Tom

 

[floune]

voici un exemple, j'ai évidemment réduis les fichiers
dans mes fichiers que je veux transférer j'ai les colonnes a à AI dans lesquelles j'ai des données
et pour les lignes cela va jusqu'à 48
les lignes 49 et 50 étant les totaux mensuels et cumul sur l'année

merci

 

[floune]

y a-t-il quelqu'un pour m'aider ?

 

[@+Thierry]

Bonjour Floune, Tom, le Forum

Comme j'avais pensé à indiquer dans notre Charte il est important d'indiquer son niveaun et spécialement par rapport au VBA dans ce cas de figure. (Article 3-d)

En effet ce que tu demandes se fera à mon avis 100% par VBA, et vu l'ampleur de l'application, il y aura besoin d'avoir certaines bases de connaissance en programmation pour comprendre ce que l'on pourrait te donner comme pistes.

Car même avec la meilleure volonté et du temps disponible, ce projet développé dans son intégralité, dépassera de loin la taille d'un Zip de 50 Ko.

Donc pour commencer je peux te donner des pistes avec des codes de programmation les plus simples possibles (au détriment de l'optimisation et rapidité, car là on fait pas d'ADO, mais on ouvre les classeurs, on les lis et on les ferme un à un...) :

Option Explicit
Option Compare Text

Const Chemin As String = "C:\Agents\Reports" '<<<<< A ADAPTER

Public Transfert As Workbook
Public Mois As String

Sub OpenFileToReportToTranfert()
Dim Fichier As Variant

Set Transfert = ThisWorkbook

Mois = InputBox("Choisir le Mois à reporter", "Sélection du Mois", "Avril")
Transfert.Sheets(Mois).Range("A4:I500").Clear

&nbsp;&nbsp;&nbsp;With Application.FileSearch
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.NewSearch
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.LookIn = Chemin
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Filename = "*.xls"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.SearchSubFolders = False
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Execute

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;For Each Fichier In .FoundFiles
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Workbooks.Open Fichier
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ReportingMacro
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Next Fichier
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With
End Sub


Sub ReportingMacro()
Dim Nom As String
Dim C As Byte
Dim CC As Byte
Dim PlageToCopy As Range, CellToCopy As Range
Dim L As Integer

C = Len(ActiveWorkbook.Name)
CC = C - 4
Nom = Left(ActiveWorkbook.Name, CC)

&nbsp;&nbsp;&nbsp;With ActiveWorkbook
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Sheets(Mois)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Set PlageToCopy = .Range("A4:A" & .Range("A4").End(xlDown).Row)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With
&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;With Transfert.Sheets(Mois)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;For Each CellToCopy In PlageToCopy
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;If IsDate(CellToCopy) Then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;L = .Range("A65536").End(xlUp).Row + 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("A" & L) = CellToCopy
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("B" & L) = Nom
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("C" & L) = CellToCopy.Offset(0, 1)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("D" & L) = CellToCopy.Offset(0, 2)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("E" & L) = CellToCopy.Offset(0, 3)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("F" & L) = CellToCopy.Offset(0, 4)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("G" & L) = CellToCopy.Offset(0, 5)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("H" & L) = CellToCopy.Offset(0, 6)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("I" & L) = CellToCopy.Offset(0, 7)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End If
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Next CellToCopy
&nbsp;&nbsp;&nbsp;End With

ActiveWorkbook.Close False
End Sub


NB : Il est à noter une "discrepancy" (comment dit-on en français !! lol) une erreur dirons nous, entre tes données du post initial et tes fichier joints...
En effet dans les données de bases tu écrit textuellement "A5 à A48 = date que je veux recopier'....... "B5 à H48 = données que je veux recopier"
Or dans tes fichiers exemples tu pars de la ligne "4" vers la ligne 48..... Ce que j'ai donc appliqué dans mon code... ligne départ = 4

Voilà sinon il te faudra modifier of course le Chemin dans la Constante en début de code, afin d'y indiquer où se trouve les fichiers que tu dois reporter (et les mettre dans ce répertoire, sans autres fichiers XLS, non-concernés)

Mise en garde Pour que ce programme fonctionne, il est impératif que tu soies ultra rigoureux et scrupuleux sur les noms d'onglets, si tu fais tourner Décembre, mais que les feuilles n'existent pas, le débugueur te le fera savoir...


Bon Week End à tous et toutes
@+Thierry

 

[floune]

merci thierry je viens d'essayer ta méthode et elle me convient très bien

Mais j'ai encore une petite question.
sur la première ligne vide après mes transferts, comment puis-je faire pour obtenir un total mensuel et sur celle du dessous, un total annuel (qui récupère le solde du mois précédent) ?

merci encore de ton aide

 

[@+Thierry]

Re Salut Floune, le Forum

Je rale, j'avais fait tout le code et un dernier test avant de sortir et je me suis planté de macro j'ai fait tourner "ReportingMacro" et boum ! le "ActiveWorkbook.Close False" m'a fermé "Transfer.xls" sans sauver le code que je venais de finir ! (ça n'arrive pas qu'aux autres lol)

Bon alors tu ajoutes ceci déjà dans "OpenFileToReportToTranfert()" en dessous de :
Mois = InputBox("Choisir le Mois à reporter", "Sélection du Mois", "Avril")
If Mois = "" Then Exit Sub

...ce qui t'évitera un bug si on annule l'input box...

Pour le rester ajoute ceci dans la même macro "OpenFileToReportToTranfert()" juste avant le End Sub
...
Next Fichier
End With
GeneratingSubTotal
End Sub


Et donc dans un module de Transfert.xls tu ajoutes cette procédure :

Sub GeneratingSubTotal()
Dim WS As Worksheet
Dim CumulMonthMontant As Double
Dim CumulMonthTPS As Double
Dim L As Integer

&nbsp;&nbsp;&nbsp;For Each WS In Worksheets
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;If WS.Name <> ActiveSheet.Name Then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;L = WS.Range("H35000").End(xlUp).Row
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CumulMonthTPS = CumulMonthTPS + WS.Range("H" & L)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CumulMonthMontant = CumulMonthMontant + WS.Range("I" & L)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End If
&nbsp;&nbsp;&nbsp;Next

&nbsp;&nbsp;&nbsp;With ActiveSheet
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("H3") = CumulMonthTPS
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Range("I3") = CumulMonthMontant

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;L = .Range("A35000").End(xlUp).Row + 1

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("A" & L)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = "Total mois"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("I" & L)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = Application.WorksheetFunction.Sum(Range("I4:I" & L - 1))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("H" & L)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = Application.WorksheetFunction.Sum(Range("H4:H" & L - 1))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("A" & L + 1)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = "Total mois"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("I" & L + 1)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = Application.WorksheetFunction.Sum(Range("I3:I" & L - 1))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;With .Range("H" & L + 1)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Value = Application.WorksheetFunction.Sum(Range("H3:H" & L - 1))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Font.Bold = True
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End With

&nbsp;&nbsp;&nbsp;End With

End Sub

Je pense que tu as tout cette fois-ci car j'ai même géré les TPS en plus des montants... Ainsi que les formats Gras...

Il est évident que je ne peux me préoccuper des valeurs réélles des mois mentionnés sur les Onglets de feuilles, si tu fais tourner ce code en avril, mais en ayant déjà les feuilles Mai et Juin existantes et remplies dans le classeur "transfert.xls" et bien tu auras le cumul de ces mois inclus dans les totaux...
Donc à faire tourner de manière logique. Pour faire un programme "intelligent" en fonction des valeur "date" des mois, il y aurait bien plus de programmation à faire mais tu ne m'as toujours pas donné d'indication sur ton niveau.

Bon Samedi
@+Thierry