Extraire des données vers une base de données

[eldoctor62]

Bonjour a tous,

J'ai crée un tableau pour plusieurs utilisateurs genre user friendly afin de gérer des pannes et le suivi de celle ci...
Tout fonctionne avec des boutons et de simple petite macro qui lorsque l'on clic sur OK ou HS cela ajoute 1 ou 0 dans une petite base de donnée qui me permet de faire des statistiques de fiabilité... (fichier-joint)

Donc, je souhaiterais faire un bouton qui permettrait d'envoyer la feuille du fichier joint quotidiennement par exemple vers un autre fichier avec comme titre en colone 1 la date du jour d'envoi

Je pourrais faire des filtres etc...

J'ai récupéré déjà quelques script ici et la mais je n'arrive pas a l'adapter

Si quelqu'un saurait m'aider à avancer sur mon bout de code ca serait top

 

[camarchepas]

Re : Extraire des données vers une base de données

Bonjour ,

Donc avec le peu d"explications (Heureusement , le fichier exemple coté saisie était présent), j'ai donc pris le cas le plus simple :


ATTENTION: Avant transfert un effacement de la feuille cible est éffectué
L'on transfert les données d'une feuille d'un classeur source vers une feuille d'un classeur synthese

voici une ébauche de code ,( A recopier en module standard par exemple )

ATTENTION , le fichier de déversement des infos doit existé et le nom de l'onglet Jour doit être remplacé par le bon nom de la feuille impactée dans ce classeur nommé pour l'exemple Installation45.xlsx (A adapter) ainsi que le chemin pour le coup dans l'exemple bidon.

A développer et sécuriser éventuellement .

Option Explicit

Sub Exporte()
Dim LigneFin As Long
Dim Info As Variant
Dim Chemin As String, Synthese As String
'A adapter ================
Chemin = "\\Central1\Fiabilite\secteur1\Bdd\"
Synthese = "Installation45.xlsx"
'===========================
LigneFin = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
Workbooks.Open Chemin & Synthese
With Workbooks(Synthese).Sheets("Jour")
 .Range("A1:AA5000").ClearContents
 ThisWorkbook.Sheets("Feuil1").Range("A1:Z" & LigneFin).Copy Destination:=.Range("A1")
End With
Workbooks(Synthese).Close True

End Sub

 

[eldoctor62]

Re : Extraire des données vers une base de données

Super merci !!

En recopiant et en adaptant ton code je parviens bien à obtenir mon fichier...

Néanmoins le hic c'est qu'il sera écrasé a chaque fois. Est ce possible de créer un fichier ?

Le script pourrait il changer le nom du fichier destination de manière systématique ? Genre un fichier unique qui porterais comme nom la date du jour ?

Exemple dans la case a1 du fichier source je met un =TODAY()
et dans le script a la place de
Synthese = "monfichierdestination.xlsx"
je ferais :
date=("A1")
Synthese = ..date.. .xlsx

Navré je débute complet dans ce language

 

[camarchepas]

Re : Extraire des données vers une base de données

Ok,

Le besoin étant plus grossier que je pensais voici le code revu
l'on recopie l'onglet ici Feuil1, dans un classeur virtuel , que l'on sauvegarde aussitot via le chemin.

L'on récupére la date du jour via date , mais les / sont interdit dans les noms de fichiers d'ou

l'utilisation de replace pour remplacer toous les / par des _.

Option Explicit
 
Sub Exporte()
  Dim Chemin As String, Synthese As String
 'A adapter ================
 Chemin ="\\Central1\Fiabilite\secteur1\Bdd\"

 'Construction du nom du fichier sauvegardé ( l'on pourrait aussi rappatrier l'heure en utilisant Now() et en remplaçant également les : par des _)

 Synthese = "Installation45_" & Replace(Date, "/", "_") & ".xlsx"
 '===========================
'Copie de la feuille 1 , comme non précisé vers un classeur virtuel
 
Sheets("Feuil1").Copy
'Le classeur virtuel devient le classeur actif ,que l'on sauvegarde 

 ActiveWorkbook.SaveAs Chemin & Synthese
'Fermeture du classeur actif en inhibant la sauvegarde puisqu'elle vient d'être effectuée 

activeworkbook.close false
 
End Sub

 

[eldoctor62]

Re : Extraire des données vers une base de données

Superbe le code fonctionne parfaitement !!! Je commence légèrement à comprendre

C'est clair le script est plus simple je vais mieux m'expliquer

Donc pour effectuer la sauvegarde c'est bon c'est TOP !

Maintenant 2 eme chose, disons que je souhaiterais prendre une plage de valeur (B3:B64) du fichier source et la coller dans un fichier destination unique genre

zone = (B3:B64) -- du fichier source --
synthese = "Installation45.xlsx" -- destination unique qui ne s'ecrase pas --

copier zone dans synthese mais sans l'ecraser... juste ajouter sur la ligne du dessous
genre zone sur (A1:A66) de synthese

Et a chaque fois que le script est joué il ajoute une ligne sur synthese

 

[camarchepas]

Re : Extraire des données vers une base de données

Re ,

donc un petit mixte entre les 2

j'ai pas pu tester ,l'ordi en vrac et l'heure déjà bien avancée.

j'essai de faire ce test dès que possible...

mais le principe

on regarde si le fichier cible existe , si ce n'est pas le cas on le créer ,

puis l'on ajoute la nouvelle tranche d'info à partir de la premiere ligne disponible de la feuille cible .

ça doit donner ça

Sub Exporte()
Dim LigneFin As Long, LigneDebut As Long
Dim Info As Variant
Dim Chemin As String, Synthese As String
'A adapter ================
Chemin = "c:\temp\" '"\\Central1\Fiabilite\secteur1\Bdd\"
Synthese = "Installation45.xlsx"
'===========================
LigneFin = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'Si le fichier n'existe pas la 1ere fois création de celui ci
If Dir(Chemin & Synthese) = "" Then
  Application.Workbooks.Add
  ActiveWorkbook.Worksheets.Add
  ActiveSheet.Name = "Jour"
  ActiveWorkbook.SaveAs Chemin & Synthese
  ActiveWorkbook.Close False
End If
Workbooks.Open Chemin & Synthese
With Workbooks(Synthese).Sheets("Jour")
 LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 1
 ThisWorkbook.Sheets("Feuil1").Range("A1:Z" & LigneFin).Copy Destination:=.Range("A" & LigneDebut)
End With
'Sauvegarde et Fermeture du classeur actif
Workbooks(Synthese).Close True

End Sub

 

[Staple1600]

Re : Extraire des données vers une base de données

Bonjour à tous


En complément de camarchepas
Ainsi paramétré le WorkBooks.Add crée un nouveau classeur d'une seule feuille.
(qu'ici pour l'exemple je renomme ensuite toto)

Sub a()
Set nWBK = Workbooks.Add(xlWBATWorksheet): nWBK.Sheets(1).Name = "toto"
End Sub

 

[eldoctor62]

Re : Extraire des données vers une base de données

Ok ca marche mais il ne selectionne pas (B3:B64) du source pour le coller dans (A1:A66) de synthese

Il continu d'ecraser avec ce sript nan ?

 

[camarchepas]

Re : Extraire des données vers une base de données

Re , @Bonjour Staple

J'intégre la suggestion de staple, petite variante d'écriture .

En relisant ta demande , je me suis aperçu que j'avais zappé la zone à copier ,

donc rectifié et testé , pour moi ok maintenant.

Sub Exporte()
 Dim LigneDebut As Long
 Dim Info As Variant
 Dim Chemin As String, Synthese As String
 Dim NouveauClasseur As Workbook
 'A adapter ================
 Chemin = "c:\temp\" '"\\Central1\Fiabilite\secteur1\Bdd\"
 Synthese = "Installation45.xlsx"
 '===========================
 'Si le fichier n'existe pas la 1ere fois création de celui ci
 If Dir(Chemin & Synthese) = "" Then
   Set NouveauClasseur = Workbooks.Add(xlWBATWorksheet)
    NouveauClasseur.Sheets(1).Name = "Jour"
    NouveauClasseur.SaveAs Chemin & Synthese
    NouveauClasseur.Close False
   Set NouveauClasseur = Nothing
 End If
'Ouverture et copie des infos B3 à B64 vers A disponible
 Workbooks.Open Chemin & Synthese
 With Workbooks(Synthese).Sheets("Jour")

 'Défini la premiere ligne libre de la colonne A  avec un interligne de 1
  LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 2
 'Copie de la zone B3:B64 vers Axx:Axx+61
  ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy Destination:=.Range("A" & LigneDebut)
 End With
 'Sauvegarde et Fermeture du classeur actif
 Workbooks(Synthese).Close True
 
End Sub

 

[eldoctor62]

Re : Extraire des données vers une base de données

lol En effet ça prends bien forme. Tu va dire que je réclame toujours un truc :-/

En fait on s'approche donc du truc mais a chaque fois que je joue le script, il écrase la précédente colonne or je voudrais qu'il la dispose a coté... car la A par ex est déjà remplis... et les infos m’intéresse ;-)
En fait je voudrai incrémenter ou ajouter une collone, je sais pas si ces termes vous interpelles...?

En fait il faudrait un 2eme "if"

genre if A=1 alors B

 

[camarchepas]

Re : Extraire des données vers une base de données

Bon là je comprend pas trop car j'écrase rien .

la nouvelle copie se fait aprés la premiere.

Maintenant si tu veux non pas les ccopier les uns en dessous des autres mais les uns à côté des autres .

ça doit pouvoir se faire , je regarde

 

[eldoctor62]

Re : Extraire des données vers une base de données

A lala !!! le boulet ... J'avais pas vu que ca ce mettait en dessous...... Arg super !!
Ok c'est presque parfait ;-)

Je voudrais en faire des lignes ... j'ai ecrit donc ca :

ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy Destination:=.Range("A1:A64" & LigneDebut)

a la place de :

ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy Destination:=.Range("A" & LigneDebut)

Mais c'est pas comme ça je pense

 

[camarchepas]

Re : Extraire des données vers une base de données

Je voudrais en faire des lignes ... j'ai ecrit donc ca :

Là , je comprends plus du tout .

Non , évidemment , ça peut pas fonctionner comme cela

Pourrais-tu reposter un petit exemple de ce que tu souhaiterais ,

pour le principe , donc juste avec 2 ou 3 infos que je comprenne , car là je plane .

 

[eldoctor62]

Re : Extraire des données vers une base de données

Ah ok ;-)

En fait je voudrais qu'à chaque fois que le script est joué
Il copie la colonne (B4:c63) du source et le colle sur la ligne (a1:a65) du destination sans écraser les valeurs déjà présentes

 

[camarchepas]

Re : Extraire des données vers une base de données

Ok,
si tu relis ta demande , c'était b3 à b64
je modifie donc pour b3 à c64:

Testé ok fonctionnellement

Sub Exporte()
  Dim LigneDebut As Long
  Dim Info As Variant
  Dim Chemin As String, Synthese As String
  Dim NouveauClasseur As Workbook
  'A adapter ================
  Chemin = "\\Central1\Fiabilite\secteur1\Bdd\"
  Synthese = "Installation45.xlsx"
  '===========================
  'Si le fichier n'existe pas la 1ere fois création de celui ci
  If Dir(Chemin & Synthese) = "" Then
    Set NouveauClasseur = Workbooks.Add(xlWBATWorksheet)
     NouveauClasseur.Sheets(1).Name = "Jour"
     NouveauClasseur.SaveAs Chemin & Synthese
     NouveauClasseur.Close False
    Set NouveauClasseur = Nothing
  End If
 'Ouverture et copie des infos B3 à C64 vers A disponible
  Workbooks.Open Chemin & Synthese
  With Workbooks(Synthese).Sheets("Jour")
 
 'Défini la premiere ligne libre de la colonne A  avec un interligne de 1
   LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 2
  'Copie de la zone B3:C64 vers Axx:Axx+61
   ThisWorkbook.Sheets("Feuil1").Range("B3:C64").Copy Destination:=.Range("A" & LigneDebut)
  End With
  'Sauvegarde et Fermeture du classeur actif
  Workbooks(Synthese).Close True
  
 End Sub