Exportation onglet avec condition

Le 14/11/2016 à 16:53

Bonjour à tous,

dans mon dossier que vous trouverez ci-joint j'ai 2 fichiers.

mon fichier principal est ODA qui comporte 3 onglets

ce que je souhaite avoir c'est historizer mes informations de chaque mois avant de passer au mois d'après par un code VBA comme ceci :

1-exporter l'onglet ODA MO dans le fichier MO (qui contient déjà les feuilles 08-16 et 09-16) en mettant 10-16 comme nom de l'onglet exporté qu'on va prendre de la cellule G1 de l'onglet ODA MO et on va le mettre après l'onglet 09-16

2-si on change 10-2016 par 11-2016 dans la cellule G1 de ODA MO il fera l'exportation de la même manière par contre si on change toutes les information et on garde 10-2016 il fera juste une mise à jour de l'onglet exporté

3-Si le fichier MO n'existe pas dans le même dossier que ODA MO, le code doit créer le fichier avec 10-16 comme premier onglet pour commencer l'historique

4-l’exportation des cellules qui contiennent les sommes en bas du tableau je ne souhaite pas le faire (H17,H18,L17,L18,O17,O18) toute en sachant de ces cellules sont variables

Cordialement

ISMAILO

17oda.xlsx (26.86 Ko)
15mo.xlsx (19.96 Ko)
Le 15/11/2016 à 13:14

Bonjour

Le fichier MO est dans le même répertoire que le fichier ODA ?

Voici déjà le code d'exportation dans lequel votre demande au point 3 n'est pas encore prise en considération

Sub exporter()
Dim nbf As Byte
Dim nom As String
Dim dlg As Integer
nom = Right(ThisWorkbook.Sheets("ODA MO").Range("G1"), 7)
With Workbooks("MO.xlsx")
    nbf = .Sheets.Count
    ThisWorkbook.Sheets("ODA MO").Copy After:=.Sheets(nbf)
    For i = 1 To nbf
        If Sheets(i).Name = nom Then Application.DisplayAlerts = False: Sheets(i).Delete
    Next
    .ActiveSheet.Name = nom
    lg = .ActiveSheet.Range("A" & .ActiveSheet.Rows.Count).End(xlUp).Row + 3
    .ActiveSheet.Rows(lg & ":" & lg + 1).Delete
End With
End Sub

Vous devez avoir les deux fichier ouverts

A vous relire

Crdlt

Le 15/11/2016 à 15:45

Bonjour Dan, le forum

(MO et ODA sont dans le même dossier)

merci beaucoup pour votre réponse c'est exactement ce que je cherche mais il y a des remarque à rectifier pour qu'il soit complet :

#premièrement le code m'oblige à ce que MO soit ouvert pour faire l'exportation alors que normalement il doit ouvrir et fermer le fichier Mo tout seul

#coller les informations en valeur sans prendre en considération les formules

#supprimer les drawings objects (les boutons qui existent dans le fichier d'origine)

#le 3ème point de mon 1er post (si MO n'existe pas il faut le créer et mettre l'onglet exporté comme premier onglet)

ci-dessous un code que j'utilise pour faire l'exportation dans un autre exemple je ne sais pas s'il peut vous aider

Sub Exporter()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Copy
With ActiveWorkbook.Sheets(1)
  .DrawingObjects.Delete
  .UsedRange = .UsedRange.Value
  With .[A6].CurrentRegion
    .Rows(.Rows.Count + 1).EntireRow.Resize(100).Delete
  End With
  .Parent.SaveAs ThisWorkbook.Path & "\" & .Name & Right(.[E1], 8), 51
  .Parent.Close
End With
End Sub
Le 15/11/2016 à 18:30

re

#coller les informations en valeur sans prendre en considération les formules

il n'y a des formules qu'en ligne 17 et 18 dans votre fichier. Juste ?

Si oui, voici le code à placer en lieu et place de celui proposé avant

Sub exporter()
'Macro Dan
Dim nbf As Byte
Dim nom As String, chemin As String, fichier As String
Dim dlg As Integer
nom = Right(ThisWorkbook.Sheets("ODA MO").Range("G1"), 7)
chemin = ThisWorkbook.Path & ":"
fichier = "MO.xlsx"
On Error Resume Next
Workbooks.Open Filename:=chemin & fichier
If Err > 0 Then
    If MsgBox("Le fichier M0 n'existe pas !. Voulez vous le creer ?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
        Workbooks.Add: ActiveWorkbook.SaveAs chemin & fichier
    Else: Exit Sub
    End If
End If
On Error GoTo 0
With Workbooks(fichier)
    nbf = .Sheets.Count
    ThisWorkbook.Sheets("ODA MO").Copy After:=.Sheets(nbf)
    For i = 1 To nbf
        If Sheets(i).Name = nom Then Application.DisplayAlerts = False: Sheets(i).Delete
    Next
    With .ActiveSheet
        .Name = nom
        lg = .Range("A" & .Rows.Count).End(xlUp).Row + 3
        .Rows(lg & ":" & lg + 1).Delete
        .DrawingObjects.Delete
    End With
    .Save
    .Close
End With
End Sub

Le code va sauver la feuille dans le fichier MO s'il existe. Dans le case où il n'existe pas, il sera créé dans le même répertoire que le fichier ODA et la feuille à sauvegardée sera rajoutée aux suivantes

Chaque sauvegarde supprime les formules 3 lignes plus bas que la dernière ligne contenant des données (donc en ligne 17 et 18 dans votre fichier) et les boutons placés sur la feuille sauvegardée

Cordialement

Le 15/11/2016 à 20:08

re dan,

il n'y a des formules qu'en ligne 17 et 18 dans votre fichier. Juste ? OUI

par contre j'ai mis les deux classeurs dans un dossier et en essayant d'appliquer votre code ça n'a pas marché

en premier lieu même si j'ai le fichier MO qui existe dans le même dossier le code ne l'a pas reconnu en me disant un fichier MO n'existe pas voulez vous le créer,

et même quand j'ai répondu par oui le code à beugé dans cette ligne

With Workbooks(fichier)
Le 16/11/2016 à 08:02

Re

Oups désolé, j'ai le code sous excel MAC et ai omis de changer une ligne

Dans le code remplacez le : par \ dans cette ligne --> chemin = ThisWorkbook.Path & "\"

Cordialement

Le 16/11/2016 à 11:01

bonjour Dan,

merci beaucoup pour votre réponse le code fonctionne comme je souhaitais mais il y'a des petites remarques à rectifier :

(j'ai rajouté au début du code : <<Application.ScreenUpdating = False>>)

1-il faut pas garder la liaison entre les feuilles (parce que dans mon fichier d'origine les données de la cellule G1 sont lié à un autre onglet)

2-si MO ne se trouve pas dans le même dossier que ODA, le code crèe bien le fichier MO avec l'onglet souhaité par contre il rajoute aussi l'onglet Feuil1 chose qu'il ne faut pas

3-le nom de l'onglet ajouté qui est bien la date de G1 s'écrit de cette manière 10-2016 alors que je souhaite qu'elle soit comme ça 10-16

Merci d'avance

Le 16/11/2016 à 13:06

Re

Concernant le point 2, ce n'est pas le code qui rajoute la feuil1 mais vos options d'excel. Au minimum il y a toujours une feuille.

Comme suite à vos 3 points, modifiez le code comme suit :

Sub exporter()
'Macro Dan
Dim nbf As Byte
Dim nom As String, chemin As String, fichier As String, mois As String
Dim dlg As Integer
mois = ThisWorkbook.Sheets("ODA MO").Range("G1")
nom = Mid(Right(mois, 7), 1, 3) & Right(mois, 2)
chemin = ThisWorkbook.Path & "\"
fichier = "MO.xlsx"
On Error Resume Next
Workbooks.Open Filename:=chemin & fichier
If Err > 0 Then
    If MsgBox("Le fichier M0 n'existe pas !. Voulez vous le creer ?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
        Workbooks.Add: ActiveWorkbook.SaveAs chemin & fichier
    Else: Exit Sub
    End If
End If
On Error GoTo 0
With Workbooks(fichier)
    nbf = .Sheets.Count
    ThisWorkbook.Sheets("ODA MO").Copy After:=.Sheets(nbf)
    For i = nbf To 1 Step -1
        If Sheets(i).Name = nom Or Sheets(i).Name = "Feuil" & i Then Application.DisplayAlerts = False: Sheets(i).Delete
    Next
    With .ActiveSheet
        .Name = nom
        .Range("G1") = mois
        lg = .Range("A" & .Rows.Count).End(xlUp).Row + 3
        .Rows(lg & ":" & lg + 1).Delete
        .DrawingObjects.Delete
    End With
    .Save
    .Close
End With
End Sub

Si ok et terminé merci de cloturer le fil

Cordialement

Le 16/11/2016 à 13:53

Merci beaucoup Dan c'est exactement ce que je cherchais

Cordialement

Ismailo

Rechercher des sujets similaires à "exportation onglet condition"