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

 

[eldoctor62]

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

Top.

Hâte d'être demain sur mon ordi au boulot pour tester ca ;-)

Il fallait bien lire b64... La je suis sur tablette c'est plus galère... Faute de frappe !

Je reviens demain ;-)

 

[eldoctor62]

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

Alors j'ai exactement la même soucis et je me demande si tu ne m'a pas envoyé le même script que le précédent

  Dim LigneDebut As Long
  Dim Info As Variant
  Dim Chemin As String, Synthese As String
  Dim NouveauClasseur As Workbook
  'A adapter ================
  Chemin = "\\main.glb.corp.local\RM-EFF$\Home\EFF\7\L0264687\Desktop\BDD\"
  Synthese = "TRUC.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: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

En fait il créer bien le fichier s'il n'existe pas, par contre il colle b3:b64 sur la colonne A...

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

Donc c'est bizarre car le libellé de l'action est

 'Copie de la zone B3:B64 vers Axx:Axx+61

 

[Staple1600]

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

Bonjour à tous

eldoctor62
???

Il copie la colonne (B4:c63) du source et le colle sur la ligne (a1:a65)

C'est une colonne pas une ligne.

Et le code de camarchepas (que je salue au passage) fonctionne et fait ce qu'il dit qu'il fait.
(copie en colonne A)

 

[camarchepas]

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

Bonjour à Tous ,

@ Staple , merci , dés fois l"on à besoin d'être rassuré avant d'en perdre son VBA.

Bon eldoctor62,

Je t'ai déjà demandé un exemple sur fichier de ce que tu voulais obtenir , car je crois qu'il y à inconpréhension quelque part .

C'est pas dur , tu prends un fichier bidon , tu y implantes une premiére série de données que tu colles en vert par exemple .

puis tu colles un nouveau une 2eme série comme tu le souhaites et là en bleu.

sinon , l'on ne va pas s'en sortir .

Sans ce fichier, je ne pourrais donner de suite à ce sujet .

 

[eldoctor62]

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

Bonjour,

Oui navré les gars je vois bien que je suis surement pas assez clair dans mes explications Vous essayer de m'aider et je vous en suis 1000 fois reconnaissant !

J'ai du coup suivi ta recommandation @camarchepas et j'ai respecté pile poile tes codes couleurs

Voici donc le fichier source et le fichier souhaité nommé destination

On va y arriver

 

[eldoctor62]

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

C'est une colonne pas une ligne.

aaaaaaah Okééé !!! En fait je peux pas transformer une colonne en ligne

Donc mon fichier source doit etre présenté sur une ligne pour que le script le copie et le colle sur une autre feuille ?

 

[camarchepas]

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

Bonjour à tous ,

Comme quoi , les fichiers exemples sont vraiment indispensables pour répondre au plus proche du besoin.

La copie doit en fait ce faire en 2 temps
la date , puis les valeurs.
j'ai enlevé l'interligne qui pour le coup ne semble plus servir à rien

Sub Export()
   Dim LigneDebut As Long
   Dim Info As Variant
   Dim Chemin As String, Synthese As String
   Dim NouveauClasseur As Workbook
   'A adapter ================
   Chemin = "\\main.glb.corp.local\RM-EFF$\Home\EFF\7\L0264687\Desktop\BDD\"
   Synthese = "TRUC.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
    LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 1
   'Copie de la date du jour
    .Range("A" & LigneDebut) = CDate(ThisWorkbook.Sheets("Feuil1").Range("A1"))
   'Transpose la zone B3:B64 vers Bxx:AZxx
    ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy
    .Range("B" & LigneDebut).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
   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

Poua magnifique @camarchepas !!! Quel script ! JOLIE !

Allé grand luxe j'en tente un dernier

Ajouter un autre if dans la fonction recuperation de la date peut etre...

C'est a dire : dans le fichier destination, si la date est déjà connu alors j’écrase la ligne et je n'incremante pas
Genre

Variables :
A1 du Source -- date
x1 du destination -- date

--
Si (A1) = (x1) alors
j'ecrase (x1)
sinon
j'incremante (x1)

C'est jouable nan ?

 

[eldoctor62]

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

    .Range("B" & LigneDebut).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Dans le collage spécial comment coller les valeurs, sans les formules ?

 

[eldoctor62]

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

je m'auto repond pour celle la ;*-)

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

 

[camarchepas]

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

Et bien voici,

j'ai essayé de commenter au plus juste (Ne pas hésiter à demander un complément d'information)

Sub Export()
    Dim LigneDebut As Long
    Dim Info As Variant
    Dim Chemin As String, Synthese As String
    Dim NouveauClasseur As Workbook
    Dim Trouve As Range
    
    '===== Chemin et nom de fichier à adapter =====
     Chemin = "c:\temp\" '"\\main.glb.corp.local\RM-EFF$\Home\EFF\7\L0264687\Desktop\BDD\"
     Synthese = "TRUC.xlsx" 'Nom du classeur de synthése
    '==============================================
    
    'Si le fichier n'existe pas la 1ere fois création de celui ci
     If Dir(Chemin & Synthese) = "" Then
      Set NouveauClasseur = Workbooks.Add(xlWBATWorksheet)
       With NouveauClasseur '
        .Sheets(1).Name = "Jour" 'Renomme l'onglet'Modifier éventuellement nom de la feuille cible
        .SaveAs Chemin & Synthese ' Sauvegarde du fichier de synthése
        .Close False ' Fermeture du classeur synthese
       End With
      'Libére la mémoire de l'objet
      Set NouveauClasseur = Nothing
     End If
    
   'Ouverture et copie des infos B3 à C64 vers A disponible
    Workbooks.Open Chemin & Synthese
      With Workbooks(Synthese).Sheets("Jour")
       
       'Recherche si journée déjà renseignée
        Set Trouve = .Range("A:A").Find(CDate(ThisWorkbook.Sheets("Feuil1").Range("A1")), lookat:=xlWhole)
        
        'Si pas renseignée
        If Trouve Is Nothing Then
          'Définit la premiere ligne libre de la colonne A
           LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 1
          'Copie de la date du jour
           .Range("A" & LigneDebut) = CDate(ThisWorkbook.Sheets("Feuil1").Range("A1"))
         
         Else
          'Si déjà connue
           LigneDebut = Trouve.Row
        End If
       
       'Transpose les infos de la colonne B3:B64 vers la ligne Bxx:AZxx
        ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy
       'Copie sous forme de valeur
       .Range("B" & LigneDebut).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=True
       Set Trouve = Nothing
      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

Bonjour,

J'ai un soucis avec le chemin je pense...

Si je met tel que dans ton script j'ai l'erreur du 1er fichier joint (capturer)

En fait lorsque je met comme chemin un dossier local par exemple : C:\Users\L0264687\Links\ et bien le script fonctionne nickel !!

J'ai donc uniquement mis : Chemin = "\\main.glb.corp.local\RM-EFF$\Home\EFF\7\L0264687\Desktop\BDD\"

Visiblement de mon poste je n'ai pas de problème...

Ce n'est rien si j'ai changer la façon de saisir le chemin ?

Aussi, je voulais savoir comment ajouter a la fin de script la ligne pour qu'il de-sélectionne la colonne qui vient d’être copier... En fait, peux être es ce plus clair si je demande s'il existe une ligne de code pour enlever du "presse papier" la colonne précédemment copier ?

Là on est dans le fignolage ^^

 

[camarchepas]

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

Bonjour ,

Pour le chemin , le principal est qu cela fonctionne

Peut être ceci pour la déselection

Application.CutCopyMode = False
Range("B8").Select

 

[eldoctor62]

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

Un grand merci @camarchepas qui aide sérieusement et script comme un fou pour nous permettre de faire des pepites ;-)

A bientot j'espere