Extraction de données

Résolu
chrispr07 -  
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. chrispr07 Auteur
    Bonjour
    ok merci ,
    sa marche

    Salutations

    Chrispr07
    0
    1. Le Pingou
      Merci, de rien.
      0
  2. Le Pingou
    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
    1. Le Pingou
      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
      1. chrispr07 Auteur
        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
        2. Le Pingou
          Bonjour chrispr07,
          Pouvez-vous préciser les noms des classeurs, feuilles ainsi que le/s répertoire/s (c:\user....)... ?

          0
          1. chrispr07 Auteur
            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
              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
          2. Le Pingou
            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
            1. chrispr07 Auteur
              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
              1. chrispr07 Auteur
                je veux extraire la feuille 1 d'un classeur A pour ensuite copier ses valeurs dans la feuille1 d'un autre classeur B
                0
                1. skk201
                  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

                  Discussions similaires

                  Problème de restrictions
                  SuperAmbi

                  5 réponses
                  Copier coller impossible
                  coulondou

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

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

                  4 réponses
                  Données mobiles activées, pas d'Internet
                  Utilisateur anonyme

                  26 réponses