Automatiser envoie de données

Question

Bonjour, j'ai un classeur Excel qui renferme plusieurs colonnes de données (une feuille par jour): classeur 1 je veux extraire dans un rapport quelques données de ce classeur si au jour j le colonne T du classeur 1 source renferme des cellules non vides ces dernières seront envoyées vers un classeur 2 voici la correspondance entre classeur 1 et classeur 2 classeur 1 source --------&gt;classeur 2 rapport (cible) la date du jour j (nom de feuille)--------&gt; colonne B colonne B --------&gt; colonne C colonne C --------&gt;colonne D D --------&gt;E T --------&gt;H W--------&gt; J et ce en balayant toutes les feuilles du classeur source (les jours d'une année) ci joint un model de mes classeurs merci de m'aider pour automatiser un travail manuel qui demandera bcp de temps merci beaucoup bien cordialement...

curulis57 · Accepted Answer

- pour démarrer la macro, double-clic, soit : * en ligne 8 de chaque feuille (les en-têtes) ; * sur la cellule "PIECE NC" de chaque feuille. 'If Not Intersect(Target, Sh.Rows(8)) Is Nothing Then If Trim(UCase(Target)) = "PIECES NC" Then À toi de choisir ce que tu préfères... - prise en compte de &#91;T:T&#93; selon tes critères If IsNumeric(tTab(y, 20)) Then _ If CInt(tTab(y, 20)) &lt;&gt; 0 Then _ - pas bien compris ta 3e demande, aussi je sauve "Safach-2" et le ferme = pas d'affichage de "Safach-2 sWBk.Close savechanges:=True A+...

curulis57 · Answer

Si je comprends bien, chaque jour (à l'ouverture du fichier ou en sortie ?), il faut parcourir toutes les feuilles jusqu'à la date du jour (y compris, je suppose) pour extraire quelques cellules de chaque ligne dont la colonne &#91;T:T&#93; n'est pas vide pour ensuite les coller (en ayant effacé les données existantes du fichier 2 -ce qui serait logique- ou en les mettant à la suite ?) dans le fichier 2 !? 365 feuilles là où 2-3 suffiraient !? Woaw ! Bonjour les yeux... C'est imposé ? A+...

curulis57 · Answer

Voivi ton fichier, à tester sur une copie de tes fichiers, bien sûr. La macro.démarre à l'ouverture du fichier. Private Sub Workbook_Open() ' Dim tTab, tExtract(), iIdx%, sSheet$ ' Application.ScreenUpdating = False ' For x = Sheets.Count To 3 Step -1 If CDate(Sheets(x).Name) &lt; Date Then With Sheets(x) sSheet = Sheets(x).Name tTab = .Range("A9:W" & .Range("A" & Rows.Count).End(xlUp).Row).Value For y = 1 To UBound(tTab, 1) If tTab(y, 20) = "" Then _ iIdx = iIdx + 1: _ ReDim Preserve tExtract(9, iIdx): _ tExtract(0, iIdx - 1) = CDate(sSheet): _ tExtract(1, iIdx - 1) = tTab(y, 2): _ tExtract(2, iIdx - 1) = tTab(y, 3): _ tExtract(3, iIdx - 1) = tTab(y, 4): _ tExtract(7, iIdx - 1) = tTab(y, 20): _ tExtract(9, iIdx - 1) = tTab(y, 23) Next End With End If Next ' On Error Resume Next If Not Workbooks("Safach-2") Is Nothing Then Set sWBk = Workbooks.Open(ThisWorkbook.Path & "\" & "Safach-2.xlsx") If Not sWBk Is Nothing Then With sWBk.Sheets(1) .Range("B7:K" & .Range("B" & Rows.Count).End(xlUp).Row + 1).Value = "" .Range("B7").Resize(iIdx, 10).Value = WorksheetFunction.Transpose(tExtract) End With End If On Error GoTo 0 ' End Sub Petit plus pour la route : - pour créer une nouvelle feuille, ton USF2 te propose d'office la date de la 3e feuille + 1 jour et vérifie que la valeur encodée est bien une date ; - le format de la date est immédiatement le bon (dd-mm-yyyy) : plus besoin de vérifier... Private Sub UserForm_Activate() ' ladate = DateAdd("d", 1, CDate(Sheets(3).Name)) ' End Sub J'ai nommé tes fichiers "Safach-1" et "Safach-2" : à toit à modifier cela après les tests. A+...

curulis57 · Answer

Déso, erreur dans cette ligne If tTab(y, 20) = "" Then _ Plutôt ceci... If tTab(y, 20) &lt;&gt; "" Then _ A+...

curulis57 · Answer

A part ainsi, je ne vois pas trop quoi faire... Ici, j'ai inclus la date du jour.. If CDate(Sheets(x).Name) &lt;= Date Then ... si tu préfères l'exclure : If CDate(Sheets(x).Name) &lt; Date Then A+...