Extraction de données

Résolu
chrispr07 Messages postés 50 Statut Membre -  
Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   -
bonjour
je viens de commencer a apprendre a manipuler les macro

je veux extraire des données d'un classeur 1 et les remplacer dans une feuille
avec la fonction clear(ou autre) et créer un bouton pour l'update ( qui permettra de prendre en compte l'extract du classeur 1
quelqu'un peut m'aider ?

10 réponses

  1.
    skk201 Messages postés 942 Date d'inscription   Statut Membre Dernière intervention   55
     
    Bonjour,

    Pas assez clair pour moi est-ce que tu peux nous donné plus de détails des exemple ou carément les classeurs en question sur Cjoint.com ?

    Merci
    0
  2. chrispr07 Messages postés 50 Statut Membre
     
    je veux extraire la feuille 1 d'un classeur A pour ensuite copier ses valeurs dans la feuille1 d'un autre classeur B
    0
  3. chrispr07 Messages postés 50 Statut Membre
     
    Private Sub Extraction_Click()

    Dim wb1, wb2 As Workbooks
    Set wb1 = Workbooks.Open("G:\Projet 5-Work In Progress")
    Set wb2 = Workbooks.Open("Kiwi_FT_Slot_-_Peanuts_-_Topic ", [C:\Users\tkoffi\Downloads)], [ReadOnly], [xls])

    wb1.Sheets("").Cells.Copy Destination:=wb2.Sheets("").Range("A1")

    End Sub

    mais sa ne marche pas du tout
    0
  4. Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   1 476
     
    Bonjour,
    Juste au passage, il manque le numéro ou nom de la feuille à copier, de même pour la destination et aussi pour le Bonjour et une petite salutation... !

    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. chrispr07 Messages postés 50 Statut Membre
     
    Bonjour a vous ,

    j'ai procédé par Macro

    Sub Extraction()
    '
    ' extraction Macro
    '

    '
    Sheets("Kiwi FT Slot - Peanuts - Topic").Select
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2:AI3468").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 3433
    ActiveWindow.ScrollRow = 3428
    ActiveWindow.ScrollRow = 3422
    ActiveWindow.ScrollRow = 3406
    ActiveWindow.ScrollRow = 3385
    ActiveWindow.ScrollRow = 3353
    ActiveWindow.ScrollRow = 3321
    ActiveWindow.ScrollRow = 3290
    ActiveWindow.ScrollRow = 3258
    ActiveWindow.ScrollRow = 3231
    ActiveWindow.ScrollRow = 3194
    ActiveWindow.ScrollRow = 3136
    ActiveWindow.ScrollRow = 3013
    ActiveWindow.ScrollRow = 2806
    ActiveWindow.ScrollRow = 2557
    ActiveWindow.ScrollRow = 2413
    ActiveWindow.ScrollRow = 2334
    ActiveWindow.ScrollRow = 2275
    ActiveWindow.ScrollRow = 2153
    ActiveWindow.ScrollRow = 2148
    ActiveWindow.ScrollRow = 2132
    ActiveWindow.ScrollRow = 2105
    ActiveWindow.ScrollRow = 2084
    ActiveWindow.ScrollRow = 2052
    ActiveWindow.ScrollRow = 2026
    ActiveWindow.ScrollRow = 1988
    ActiveWindow.ScrollRow = 1941
    ActiveWindow.ScrollRow = 1898
    ActiveWindow.ScrollRow = 1861
    ActiveWindow.ScrollRow = 1818
    ActiveWindow.ScrollRow = 1776
    ActiveWindow.ScrollRow = 1718
    ActiveWindow.ScrollRow = 1611
    ActiveWindow.ScrollRow = 1463
    ActiveWindow.ScrollRow = 1261
    ActiveWindow.ScrollRow = 1128
    ActiveWindow.ScrollRow = 1022
    ActiveWindow.ScrollRow = 953
    ActiveWindow.ScrollRow = 894
    ActiveWindow.ScrollRow = 846
    ActiveWindow.ScrollRow = 809
    ActiveWindow.ScrollRow = 772
    ActiveWindow.ScrollRow = 746
    ActiveWindow.ScrollRow = 719
    ActiveWindow.ScrollRow = 703
    ActiveWindow.ScrollRow = 698
    ActiveWindow.ScrollRow = 692
    ActiveWindow.ScrollRow = 687
    ActiveWindow.ScrollRow = 671
    ActiveWindow.ScrollRow = 639
    ActiveWindow.ScrollRow = 592
    ActiveWindow.ScrollRow = 538
    ActiveWindow.ScrollRow = 491
    ActiveWindow.ScrollRow = 448
    ActiveWindow.ScrollRow = 411
    ActiveWindow.ScrollRow = 374
    ActiveWindow.ScrollRow = 342
    ActiveWindow.ScrollRow = 289
    ActiveWindow.ScrollRow = 283
    ActiveWindow.ScrollRow = 273
    ActiveWindow.ScrollRow = 257
    ActiveWindow.ScrollRow = 230
    ActiveWindow.ScrollRow = 209
    ActiveWindow.ScrollRow = 193
    ActiveWindow.ScrollRow = 177
    ActiveWindow.ScrollRow = 172
    ActiveWindow.ScrollRow = 156
    ActiveWindow.ScrollRow = 140
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 2
    Range("A2").Select
    Windows("Kiwi_FT_Slot_-_Peanuts_-_Topic - Copie.xlsm").Activate
    Sheets("Kiwi FT Slot - Peanuts - Topic").Select
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A2:AI3469").Select
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.LargeScroll Down:=-19
    ActiveWindow.ScrollRow = 2746
    ActiveWindow.ScrollRow = 2741
    ActiveWindow.ScrollRow = 2736
    ActiveWindow.ScrollRow = 2730
    ActiveWindow.ScrollRow = 2725
    ActiveWindow.ScrollRow = 2720
    ActiveWindow.ScrollRow = 2714
    ActiveWindow.ScrollRow = 2709
    ActiveWindow.ScrollRow = 2704
    ActiveWindow.ScrollRow = 2693
    ActiveWindow.ScrollRow = 2683
    ActiveWindow.ScrollRow = 2677
    ActiveWindow.ScrollRow = 2661
    ActiveWindow.ScrollRow = 2629
    ActiveWindow.ScrollRow = 2582
    ActiveWindow.ScrollRow = 2523
    ActiveWindow.ScrollRow = 2242
    ActiveWindow.ScrollRow = 2030
    ActiveWindow.ScrollRow = 1971
    ActiveWindow.ScrollRow = 1929
    ActiveWindow.ScrollRow = 1913
    ActiveWindow.ScrollRow = 1897
    ActiveWindow.ScrollRow = 1892
    ActiveWindow.ScrollRow = 1886
    ActiveWindow.ScrollRow = 1860
    ActiveWindow.ScrollRow = 1823
    ActiveWindow.ScrollRow = 1786
    ActiveWindow.ScrollRow = 1695
    ActiveWindow.ScrollRow = 1647
    ActiveWindow.ScrollRow = 1552
    ActiveWindow.ScrollRow = 1509
    ActiveWindow.ScrollRow = 1329
    ActiveWindow.ScrollRow = 1260
    ActiveWindow.ScrollRow = 1154
    ActiveWindow.ScrollRow = 1138
    ActiveWindow.ScrollRow = 1117
    ActiveWindow.ScrollRow = 1111
    ActiveWindow.ScrollRow = 1095
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 1021
    ActiveWindow.ScrollRow = 915
    ActiveWindow.ScrollRow = 331
    ActiveWindow.ScrollRow = 209
    ActiveWindow.ScrollRow = 2
    Selection.Copy
    Windows("Kiwi_FT_Slot_-_Peanuts_-_Topic .xlsm").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End Sub

    mais j'ai bien peur que sa ne soit optimal
    mais dans le pire des cas j'aimerais creer un bouton qui me permettrait de realiser cette macro
    et j'aimerais que ce bouton la apparaisse dans la partie complément d'excel

    Comment proceder?

    Salutations
    Chrispr07
    0
    1. skk201 Messages postés 942 Date d'inscription   Statut Membre Dernière intervention   55
       
      Je pense qu'on peux commencer par ça :
      On Error Resume Next 
      Sub Extraction()
'
' extraction Macro
'
Sheets("Kiwi FT Slot - Peanuts - Topic").Select
Range("A2:AI3468").Select
Selection.ClearContents
Windows("Kiwi_FT_Slot_-_Peanuts_-_Topic - Copie.xlsm").Activate
Sheets("Kiwi FT Slot - Peanuts - Topic").Select
Range("A2:AI3469").Select
Selection.Copy
Windows("Kiwi_FT_Slot_-_Peanuts_-_Topic .xlsm").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub


      Personnellement ce n'est pas forcément ce que j'aurai fait mais si ça tiens la route pour vous :)

      Après pour crée un bouton : 

      Private Sub Workbook_Open()
On Error Resume Next
Dim CmdBar As CommandBar
Dim bouton As CommandBarButton
 'Création de la barre d'outils
Set CmdBar = Application.CommandBars.Add(Name:="TOOL", Position:=msoBarTop, Temporary:=True)
CmdBar.Visible = True

    Set bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With bouton
        .Style = msoButtonIconAndCaption
        .FaceId = 480 ' pour trouvé d'autres images taper "FACEID" sur google et entrez le code de l'image
        .Caption = "Nom du bouton"
        .OnAction = "Extraction"
    End With
End Sub

'-------------------------------------Pour un une fermeture sans acro (pas obligatoire)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
Application.CommandBars("TOOL").Delete
End Sub
      0
  7. Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   1 476
     
    Bonjour chrispr07,
    Pouvez-vous préciser les noms des classeurs, feuilles ainsi que le/s répertoire/s (c:\user....)... ?

    0
  8. chrispr07 Messages postés 50 Statut Membre
     
    salut,
    j'ai reussi a faire ce que je voulais
    du coup je tiens a vous dire merci

    voici le code concernant la mise a jour de ma feuille 

    Sub Updating()
    '
    ' Updating Macro
    '

    '
        Dim nom_fichier As Variant
        Dim wbMyWb As Workbook
        'Dim monfichier As String
        'Dim wbExcel As Workbook

    nom_fichier = Application.GetOpenFilename("fichiers Excel (*.xlsm), *.xlsm")
        
        If nom_fichier <> False Then
         Set wbMyWb = Workbooks.Open(nom_fichier)
         wbMyWb.Activate
         
        End If

    Workbooks.Open fileName:="C:\Users\tkoffi\Documents" & "Kiwi_FT_Slot_-_Peanuts_-_Topic " & ".xlsm"
        
            Sheets("Kiwi FT Slot - Peanuts - Topic").Select
            Range("A2:AI3468").Select
            Selection.ClearContents
            Range("A2").Select
            wbMyWb.Activate
            Sheets("Kiwi FT Slot - Peanuts - Topic").Select
            Range("A2:AI3469").Select
            Selection.Copy
            Windows("Kiwi_FT_Slot_-_Peanuts_-_Topic .xlsm").Activate
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'End Sub

    End Sub


    j'aimerais savoir s'il ya moyen de l'optimiser
    0
  9. Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   1 476
     
    Bonjour,
    Oui il peut être optimisé, mais auparavant Est-ce que votre code fonctionne correctement... car j'ai un doute sur cette ligne d'instruction: 
    Workbooks.Open fileName:="C:\Users\tkoffi\Documents" & "Kiwi_FT_Slot_-_Peanuts_-_Topic " & ".xlsm"
    ?
    0
  10. Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   1 476
     
    Bonjour,
    Voici le code améliorer et tester : 

    Sub Updating()
    '
    Dim nom_fichier As Variant
    Dim wbshso As Object
       
    nom_fichier = Application.GetOpenFilename("fichiers Excel (*.xlsm), *.xlsm")
    If nom_fichier <> False Then
    '  fichier source wbshso
        Set wbshso = Workbooks.Open(nom_fichier).Sheets("Kiwi FT Slot - Peanuts - Topic")
    End If
    '  fichier cible
    Workbooks.Open Filename:="C:\Users\tkoffi\Documents" & "Kiwi_FT_Slot_-_Peanuts_-_Topic " & ".xlsm"
    Sheets("Kiwi FT Slot - Peanuts - Topic").Range("A2:AI" & Cells(Rows.count, 1).End(xlUp).Row).ClearContents
    wbshso.Range("A2:AI" & wbshso.Cells(Rows.count, 1).End(xlUp).Row).Copy
    Sheets(1).Range("A2").PasteSpecial Paste:=xlPasteValues
    MsgBox "les nouvelle données sont extraites et copiées. "
    End Sub

    PS: Le votre ne fonctionne pas au niveau de la ligne mentionnée dans le message précédent.
    0
  11. chrispr07 Messages postés 50 Statut Membre
     
    Bonjour
    ok merci ,
    sa marche

    Salutations

    Chrispr07
    0
    1. Le Pingou Messages postés 12274 Date d'inscription   Statut Contributeur Dernière intervention   1 476
       
      Merci, de rien.
      0

Discussions similaires

Problème de restrictions
SuperAmbi -
Pat -

5 réponses
Copier coller impossible
coulondou -
jeanmarc -

43 réponses
je tombe sur le service de diffusion des donnees?que faire?
cockies -
PeterPan972 -

5 réponses
TNT base de donnees vide!!
Angye25 -
Angye25 -

4 réponses
service diffusion de données
Diego -
stewartia -

1 réponse