Extraction de données

Résolu

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention -
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention - 9 août 2014 à 21:57

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 ?

A voir également:

Extraction de données
Fuite données maif - Guide
Supprimer les données de navigation - Guide
Trier des données excel - Guide
Reinstaller windows sans perte de données - Guide
Sauvegarde des données - Guide

10 réponses

Réponse 1 / 10

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention 54

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

Réponse 2 / 10

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention

je veux extraire la feuille 1 d'un classeur A pour ensuite copier ses valeurs dans la feuille1 d'un autre classeur B

Réponse 3 / 10

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention

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

Réponse 4 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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... !

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

Posez votre question

Réponse 5 / 10

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention

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

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention 54

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

Réponse 6 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour chrispr07,
Pouvez-vous préciser les noms des classeurs, feuilles ainsi que le/s répertoire/s (c:\user....)... ?

Réponse 7 / 10

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention

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

Réponse 8 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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"

Réponse 9 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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.

Réponse 10 / 10

chrispr07 Messages postés 47 Date d'inscription Statut Membre Dernière intervention

Bonjour
ok merci ,
sa marche

Salutations

Chrispr07

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Merci, de rien.

Discussions similaires

Erreur la zone de données passée à un appel système est insu

Barre de données en pourcentage (maintenir 100% comme max)

je tombe sur le service de diffusion des donnees?que faire?

TNT base de donnees vide!!

Cette valeur ne correspond pas aux restrictions

Votre réponse

Discussions similaires