Discussion :

[jojo7244]

bonjour à tous,

j'ai réalisé une macro pour copier des données d'un fichier A (dont les cellules sont toujours les mêmes) vers un ficher B. ce code marche très bien en allant chercher la macro.
j'ai essayé de placer un bouton sur le ficher B en insérant mon code, et là, ça ne marche plus : il n'arrive pas à sélectionner les cellules A4 à CF4.

quelqu'un aurait-il la solution?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub ouverture_rapport_Click()
 
Set registre = ActiveWorkbook 'selectionne le fichier excel actuel'
registre.Sheets("Registre_nom_opérateur_société").Select
Range("A4").End(xlDown).Offset(1, 0).Select
Set cellule = ActiveCell
'selection de la première case vide à suivre
 
'parcourir le /C pour trouver le fichier'
rapport = Application.GetOpenFilename("Fichier Excel(*.xls;*.xlsm;*.xlsx;*.xlt.m),*.xls;*.xlsm;*.xlsx;*.xltm")
 
Set rapp = Workbooks.Open(rapport)  'ouverture fichier'
    Worksheets("Registre").Range("A4:CF4").Select 'sélection des cellules
    Selection.Copy 'copie des données'
 
 
'collage des valeurs dans les cellules précédements définies'
    registre.Activate
    Sheets("Registre_nom_opérateur_société").Select
    cellule.PasteSpecial (xlPasteValues)
 
rapp.Close False 'fermeture sans enregistrer"
 
 
 
End Sub

[had4789]

Bonjour,

Tu as essayé en enregistrant ta macro dans ton fichier B?

[jojo7244]

oui la macro est enregistrée, quand je fais macro/executer ça marche.
quand je l'intègre dans le bouton ça ne marche plus.

[had4789]

Ton problème vient peut être de cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set registre = ActiveWorkbook

Si tu places ton bouton dans ton fichier B alors celui devient le classeur actif et tu effectue donc ta sélection dans ce dernier.

Cordialement

[mercatog]

Déjà regarde ton code initial modifié avec adressage complet des plages et sans les Select/Activate. Tu sauras l'adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub ouverture_rapport_Click()
Dim Rapp As Workbook
Dim Rapport
 
Application.ScreenUpdating = False
Rapport = Application.GetOpenFilename("Fichier Excel(*.xls*),*.xls*")
If Rapport <> False Then
    Set Rapp = Workbooks.Open(Rapport)
 
    With ThisWorkbook.Worksheets("Registre_nom_opérateur_société")
        .Cells(.Rows.Count, 1).End(xlUp)(2).Resize(, 84).Value = Rapp.Worksheets("Registre").Range("A4:CF4").Value
    End With
 
    Rapp.Close False
    Set Rapp = Nothing
End If
End Sub

[jojo7244]

ah oui en effet,

quand j'écrit juste le nom de la macro à la place de faire un copié/collé du code ça marche.

va savoir pourquoi.

merci de ton aide

[Thautheme]

Bonjour Jojo, le fil, bonjour le forum,

Peut-être comme ça (non testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub ouverture_rapport_Click()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim rapport As String 'déclare la variable rapport
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets("Registre_nom_opérateur_société") 'définit l'onglet destination OD
Set DEST = OD.Range("A4").End(xlDown).Offset(1, 0) 'définit la cellule de destination DEST
rapport = Application.GetOpenFilename("Fichier Excel(*.xls;*.xlsm;*.xlsx;*.xlt.m),*.xls;*.xlsm;*.xlsx;*.xltm")
Set CS = Workbooks.Open(rapport)   'définit le classeur source CS
Set OS = CS.Sheets("Registre") 'définit l'onglet source OS
OS.Range("A4:CF4").Copy 'copy la plage A4:CF4
DEST.PasteSpecial (xlPasteValues) 'colle les valeurs de la plage copiée dans DEST
CS.Close False 'fermeture sans enregistrer"
End Sub

Évite autant que possible les select qui ne font que ralentir l'exécution du code...

[jojo7244]

Merci beaucoup pour ton code Thautheme.

[jojo7244]

pour ceux qui auraient le temps de "s'amuser" j'aimerai rendre automatique la copie des données :

au lieu d'aller chercher le fichier excel par son nom, rechercher les rapports qui n'ont pas encore été enregistrés.

les rapporst sont dans le dossier C\rapports\pro et C\rapport\particuliers et les fichiers excel sont tous nommés "rapport NOM1" ou "rapport NOM1 - NOM2"
les noms sont également renseignés dans la colonne D sous "NOM1" ou "NOM1 - NOM2" des rapport et font partie des lignes à copier. Le nom des rapports déjà copiés sont donc dans la colonne D du du classeur de sauvegarde "2014registre" ou CD sur le code de Thautheme

mais je ne suis pas sur que ce soit réalisable.

[Nico Chg]

Bonjour,

En général, tout est réalisable, ce n'est qu'une question de temps.

je n'ai pas beaucoup de temps, alors voila ce que je te propose (je n'ai pas tester, c'est à toi de l'adapter)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub ParcoursClasseur()
 
Dim ActWbk as Workbook
Dim oFSO as object
 
Dim LAstLine as single
Dim I as single
Dim WbkName as string
Dim WbkPath as string
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ActWbk = ThisWorkbook
'Définis le classeur actif
 
LastLine = ActWbk.Columns(4).Find("*", , , , xlByRows, xlPrevious).Row
'Définis la dernière ligne de la colonne D
 
For I = 0 to LastLine
'Parcours les lignes
     WbkName = ActWbk.Worksheets("TotO").Cells(I, 4)
     'Définis le nom du classeur
     WbkPath = ""
     If oFSO.FileExists("C\rapports\pro\" & WbkName) Then Wbkpath = "C\rapports\pro\" & WbkName
     'Si le Classeur existe dans le répertoire précedent, affecte le chemin a une variable
 
     If oFSO.FileExists(" C\rapport\particuliers\" & WbkName) Then Wbkpath = "C\rapports\particuliers\" & WbkName
     'Si le Classeur existe dans le répertoire précedent, affecte le chemin a une variable
 
     If WbkPath <> "" then Call ouverture_rapport_Click(WbkPath)
     'Si le chemin n'est pas égale a "" alors appelle la procédure de Thautheme.
Next I
'Cette partie la est très certainement à améliorer
End sub
 
Private Sub ouverture_rapport_Click(rapport as string)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim rapport As String 'déclare la variable rapport
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets("Registre_nom_opérateur_société") 'définit l'onglet destination OD
Set DEST = OD.Range("A4").End(xlDown).Offset(1, 0) 'définit la cellule de destination DEST
'rapport = Application.GetOpenFilename("Fichier Excel(*.xls;*.xlsm;*.xlsx;*.xlt.m),*.xls;*.xlsm;*.xlsx;*.xltm")
'Cette ligne n'a plus raison d'être, le chemin du classeur est passé en argument de la Sub
Set CS = Workbooks.Open(rapport)   'définit le classeur source CS
Set OS = CS.Sheets("Registre") 'définit l'onglet source OS
OS.Range("A4:CF4").Copy 'copy la plage A4:CF4
DEST.PasteSpecial (xlPasteValues) 'colle les valeurs de la plage copiée dans DEST
CS.Close False 'fermeture sans enregistrer"
End Sub