SOS: copie de feuille dans un autre classeur

Fermé
bocman - 15 févr. 2012 à 09:54
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 17 févr. 2012 à 07:02
Bonjour,

j'ai besoin d'un renseignement.
j'ai deux fichiers Excel
le premier qui est le fichier source s'appelle EXTRACTION.xls avec une feuille qui s'appelle "summary" qui contient des données
le deuxième qui sera le fichier cible s'appel QAcier.xls avec une feuille qui s'appel "Extraction" qui devra contenir les données de la feuille "summary" du fichier EXCTRACTION.xls.

Pour cela j'ai créé un bouton sur la feuille du fichier QAcier.xls qui lorsque je clique dessus me permettra d'avoir les données de la feuille "summary" du fichier "Extraction" dans la feuille "Extraction" du fichier QAcier.xls

J'ai créé le début de mon programme mais il me manque la fin.
Si vous pouviez m'aider.

Sub MAJ()
Dim cellule As Range, Ligne As Integer, colonne As Integer
EXTRACTION = "J:\Projet LP CAODAO\Projet 2.0\EXCEL\EXTRACTION.xls"
Workbooks.Open (EXTRACTION)
Ligne = 1
colonne = 1
For Each celle In Workbooks(EXTRACTION)
celle(Ligne, colonne) = Workbooks.Sheet.celle.Value("Extraction")
Ligne = Ligne + 1
Next
End Sub




2 réponses

lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 191
Modifié par lermite222 le 15/02/2012 à 13:37
Bonjour, bonjour pijaku,
Apparemment le feuille EXTRACTION est soit vide ou les données existantes sont écrasées.
Dans ces conditions, une autre solution...
Sub MAJ() 
Dim NomSource As String, i As Integer 
    For i = 1 To Sheets.Count 'supprime la feuille EXTRACTION si existe 
        If Sheets(i).Name = "EXTRACTION" Then Sheets(i).Delete: Exit For 
    Next i 
    NomSource = "J:\Projet LP CAODAO\Projet 2.0\EXCEL\EXTRACTION.xls" 
    Workbooks.Open (NomSource) 
    ActiveWorkbook.Sheets("EXTRACTION").Copy before:=ThisWorkbook.Sheets(1) 
    ActiveWorkbook.Close 
End Sub

A+
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
1
Merci

Par contre j'aimerai que ça me ferme aussi EXTRACTION.xls

j'ai rajouter
Workbooks.close (NomSource) mais ça n'a pas l'air d'etre cela
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 191
Modifié par lermite222 le 16/02/2012 à 12:18
Tu ajoute après la ligne..
'.... 
 ActiveWorkbook.Sheets("EXTRACTION").Copy before:=ThisWorkbook.Sheets(1)  
    ActiveWorkbook.Close

'Cette ligne
    ThisWorkbook.Close True

Pour sauver la modif et fermer le classeur . EXTRACTION.xls
A+
0
ça ne marche pas; ça me ferme que le fichier QAcier.xls
mais pas le fichier EXTRACTION.xls
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 191
Modifié par lermite222 le 17/02/2012 à 07:02
Bon, beh essaye alors avec
    WorkBooks("EXTRACTION.xls").close true
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
15 févr. 2012 à 11:47
Bonjour,

essayez ceci (non testé) :

Sub ImportDonnees()
Dim Extraction As String, DernCel As String
Dim RngUtile As Range
Dim TablDonnées()
Dim Col As Long, Lig As Long, DrLig As Long

'ouverture du fichier "source"
Extraction = "J:\Projet LP CAODAO\Projet 2.0\EXCEL\EXTRACTION.xls" 
Workbooks.Open (Extraction)

'on remplit une variable tableau (TablDonnées) avec les éléments contenus dans 
'la feuille summary
With ActiveWorkbook.Worksheets("summary")
    DernCel = .Range("A1").SpecialCells(xlCellTypeLastCell).Address
    Set RngUtile = .Range("A1:" & DernCel)
    TablDonnées() = RngUtile
End With

'on ferme le classeur source
ActiveWorkbook.Close

'restitution des données
With Workbooks("QAcier.xls").Worksheets("summary")
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Col = 1 To UBound(TablDonnées, 2)
        For Lig = 1 To UBound(TablDonnées, 1)
            On Error Resume Next ' Si erreur renvoyée par une formule
            .Cells(Lig + DrLig, Col) = TablDonnées(Lig, Col)
            On Error GoTo 0
        Next Lig
   Next Col
End With
0