Ouvrir fichier excel en vba

Version imprimable

Bonjour à tous,

Je voudrai faire un programme vba capable d'aller chercher des infos dans un classeur excel fermé situé sur le disque dur et que les données de ce classeur ce "colle" dans un autre fichier excel.

En clair, j'ai mon fichier "MC_essai" qui doit aller prendre des infos dans le fichier excel "MC_Plastique" et coller les infos de "MC_Plastique" dans "MC_essai" Cependant, je veux récupérer que les infos concernant un N° de semaine précis. Et je n'arrive pas à faire ce dernier point.

Quelqu'un pourrait il regarder mon programme et me dire ce qui ne va pas svp!

Merci, par avance, pour votre aide

Rob's

Mon programme:

Code:

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Dim newRecord As Long
Dim Date_D As Date
Private Sub Annuler_Click()
    Unload Me
    newRecord = Range("A" & Rows.Count).End(xlUp)(2).Row
    Rows(newRecord).Select
    Call viderFormulaire
End Sub
Private Sub UserForm_Activate()
    Call chargerListes
End Sub
Private Sub Valider_Click()
 
' Champs obligatoires
 
    If Atelier.Text = "" Then
        MsgBox "Le champs Atelier n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
        Exit Sub
    End If
 
   If N°Semaine.Text = "" Then
      MsgBox "Le champs N°Semaine n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
       Exit Sub
   End If
 
' Récupération des données dans classeur fermé
 
Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
Workbooks.Open Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Main_courante_atelier\MC_Plastique.xlsm"
Workbooks("MC_Plastique.xlsm").Worksheets("Synthese").Cells.Copy _
    Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A1")
Workbooks("MC_Plastique.xlsm").Close False
 
UserForm1.Hide
 
End Sub
 Private Sub chargerListes()
 
    'Défauts par l'atelier
 
    UserForm1.Atelier.AddItem "Contrôle SF-A"
    UserForm1.Atelier.AddItem "Débit"
    UserForm1.Atelier.AddItem "Expédition"
    UserForm1.Atelier.AddItem "Finition"
    UserForm1.Atelier.AddItem "Metal"
    UserForm1.Atelier.AddItem "Plastique"
    UserForm1.Atelier.AddItem "Qualité"
    UserForm1.Atelier.AddItem "Luxe"
    UserForm1.Atelier.AddItem "Réception Fournisseur"
    UserForm1.Atelier.AddItem "Responsable Qualité"
    UserForm1.Atelier.AddItem "Shootage"
    UserForm1.Atelier.AddItem "Tri branches"
    UserForm1.Atelier.AddItem "Tri faces"
    UserForm1.Atelier.AddItem "TS"
    UserForm1.Atelier.AddItem "Witech"
 
End Sub
 
Private Sub viderFormulaire()
    Atelier.Text = ""
    N°Semaine.Text = ""
 
End Sub
Private Sub tracerBordures(ByVal Ligne As Long)
 
    Range(Cells(Ligne, 1), Cells(Ligne, 15)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = 1
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = 1
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = 1
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = 1
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub

03/12/2013, 11h29
Oliv-

Bonjour,
Si tu ouvres ton classeur,
ela dépend comment sont structurées tes données (N° de semaine) si c'est en listes utilises un filtre !
03/12/2013, 12h01
Rob's

1 pièce(s) jointe(s)

Bonjour Oliv-

Je ne peux pas faire de filtre, car j'utilise un userform qui demande le n°semaine souhaité.

Je te mets en pièce jointe les documents concernant mon problème, ainsi tu comprendas mieux ce qui me pose soucis.

Merci pour ton aide

le filtre c'est dans le classeur MC_plastique qu'il faut l'appliquer

Code:

1
2
3
4
5
6
 
set ws_Source=Workbooks("MC_Plastique.xlsm").Worksheets("Synthese")
ws_Source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                         N°Semaine.Text
    Set MaSelection = ws_Source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    MaSelection.Select

et après tu fais ta copie

Bonjour Oliv-

Merci pour ton aide mais, j'ai encore un soucis.
Lorsque je lance l'application, je vois que le programme prend les bons n° de semaine de MC_Plastique mais, il n'arrive pas à les coller dans "MC_essai.
En effet, un message d'erreur s'affiche: "Microsoft Excel a cesser de fonctionner...".
Est-ce que le programme est trop difficile à gérer?
Si tu pouvais m'éclairer ce serait super!

Merci par avance pour ton aide.

Rappel de mon programme:

Code:

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
Private Sub Valider_Click()
 
' Champs obligatoires
 
    If Atelier.Text = "" Then
        MsgBox "Le champs Atelier n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
        Exit Sub
    End If
 
   If N°Semaine.Text = "" Then
      MsgBox "Le champs N°Semaine n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
       Exit Sub
   End If
 
' Récupération des données dans classeur fermé
 
 
Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
Workbooks.Open Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Plastique.xlsm"
Set ws_Source = Workbooks("MC_Plastique.xlsm").Worksheets("Synthese")
ws_Source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                         N°Semaine.Text
    Set MaSelection = ws_Source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    MaSelection.Select
Workbooks("MC_Plastique.xlsm").Worksheets("Synthese").Cells.Copy _
    Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A1")
Workbooks("MC_Plastique.xlsm").Close False
 
UserForm1.Hide
 
End Sub

SAlut,
en fait ce serait plutot comme cela :

Code:

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
Private Sub Valider_Click()
Dim MaSelection As Range
Dim Wb_source As Workbook
Dim Ws_source As Worksheet
' Champs obligatoires
 
    If Atelier.Text = "" Then
        MsgBox "Le champs Atelier n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
        Exit Sub
    End If
 
    If N°Semaine.Text = "" Then
        MsgBox "Le champs N°Semaine n'a pas été rempli. Veuillez le remplir.", vbOKOnly + vbInformation, "Champs manquants ou incorrects"
        Exit Sub
    End If
 
    ' Récupération des données dans classeur fermé
 
 
    Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
 
'    Set wb_Source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Plastique.xlsm")
    Set Wb_source = Workbooks.Open(Filename:="d:\Document\Mes documents\Downloads\robs\MC_Plastique_test.xlsm")
 
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
   ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A5")
    Wb_source.Close False
 
    UserForm1.Hide
 
End Sub

04/12/2013, 09h58
Rob's

Merci beaucoup Oliv-

Ca fonctionne à merveille :D

Par contre, j'ai 5 autres fichiers à aller chercher en plus de MC_Plastique.
Faut-il que je copie les lignes de pgm précédentes et que je remplace "MC_Plastique" par "MC_Finition" ou y a-t-il une autre méthode?

Merci pour ton aide!
04/12/2013, 10h11
Oliv-

Oui mais attention où tu les colles

Oui en effet, moi j'avais tout simplement fait comme ceci mais, le programme ne m'affiche que les données du dernier atelier et non pas les données de tous les ateliers!

Comment faut il faire? Utiliser "AND" mais je n'arrive à l'utiliser correctement...

Merci pour ton aide

Code:

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
 Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
 
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Main_courante_atelier\MC_Plastique.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
   ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A5")
    Wb_source.Close False
 
  Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
 
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Main_courante_atelier\MC_Expédition.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
   ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A5")
    Wb_source.Close False
    UserForm1.Hide
 
End Sub

04/12/2013, 11h12
Oliv-
Les données de l' atelier suivant vont où ? a la suite des précedentes ?

il faut donc que tu cherches la dernière ligne

déjà commence par déclarer des objets
Code:

1 2 set wb_destination = Workbooks("MC_essai.xlsm") Set ws_destination = wb_destination.Worksheets("Saisie")
c'est plus simple que de travailler avec Workbooks("MC_essai.xlsm").Worksheets("Saisie")
comme cela
Code:

1 2 3 dim ZoneColle as range Set zoneColle=ws_destination.range("a65536").end(xlup).offset(1,0) MsgBox zoneColle.Address
à condition qu'il y ait toujours quelque chose dans la colonne A

sinon utiliser une autre colonne:

Code:

Set zoneColle=ws_destination.range("B65536").end(xlup).offset(1,-1)

ensuite tu fais
Code:

1 2 MaSelection.SpecialCells(xlCellTypeVisible).Copy _ ZoneColle

Je ne comprends pas.
J'ai l'impression que le programme efface les données de l'atelier précédent pour ne garder que ceux du dernier du programme.

J'y comprends rien.
Merci de m'éclairer...

Code:

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
Private Sub Valider_Click()
 
Dim MaSelection As Range
Dim Wb_source As Workbook
Dim Ws_source As Worksheet
Dim ZoneColle As Range
 
    ' Récupération des données dans classeur fermé
 
    Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Plastique.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
   ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A5")
    Set ZoneColle = Ws_source.Range("a65536").End(xlUp).Offset(1, 0)
    Wb_source.Close False
 
Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Expédition.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
   ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            Workbooks("MC_essai.xlsm").Worksheets("Saisie").Range("A5")
    Set ZoneColle = Ws_source.Range("a65536").End(xlUp).Offset(2, 0)
    MsgBox ZoneColle.Address
    Wb_source.Close False
 
 UserForm1.Hide
 
End Sub

forcément tu as tout mélangé !

Code:

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
54
55
56
57
58
59
60
61
62
Private Sub Valider_Click()
 
    Dim MaSelection As Range
 
    Dim wb_destination As Workbook
    Dim ws_destination As Worksheet
 
    Set wb_destination = Workbooks("MC_essai.xlsm")
    Set ws_destination = wb_destination.Worksheets("Saisie")
 
    Dim Wb_source As Workbook
    Dim Ws_source As Worksheet
 
    Dim ZoneColle As Range
 
    ' Récupération des données dans classeur fermé que j'ouvre !!
 
' ca tu le fait 1 seule fois !
    Workbooks("MC_essai.xlsm").Worksheets("Saisie").Cells.ClearContents
 
' premier atelier
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Plastique.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            wb_destination.Range("A5")
    Wb_source.Close False
 
' zonecolle fait référence à Workbooks("MC_essai.xlsm").Worksheets("Saisie")
    Set ZoneColle = ws_destination.Range("a65536").End(xlUp).Offset(1, 0)
 
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Expédition.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            ZoneColle
    Wb_source.Close False
 
'ici le suivant
    Set ZoneColle = ws_destination.Range("a65536").End(xlUp).Offset(1, 0)
 
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\??????.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            ZoneColle
    Wb_source.Close False
 
 
 
    UserForm1.Hide
 
End Sub

Oula! Oui en effet!

Cependant, il y un message d'erreur quand le programme commence à aller chercher les infos dans MC_Plastique:

"Propriété ou méthode non géré par cet objet"

En rouge ce qu'il me surligne:

Code:

1
2
3
4
5
6
7
8
9
' premier atelier
    Set Wb_source = Workbooks.Open(Filename:="\\Gpao\commun\30_QUALITE\\307_Gestion_de_service\Lyse\Main_courante_atelier\MC_Plastique.xlsm")
    Set Ws_source = Wb_source.Worksheets("Synthese")
    Ws_source.ListObjects("Tableau1").Range.AutoFilter Field:=2, Criteria1:= _
                                                       N°Semaine.Text
    Set MaSelection = Ws_source.Range(Range("A5"), Cells(Range("B65536").End(xlUp).Row, 19))
    ' MaSelection.Select
    MaSelection.SpecialCells(xlCellTypeVisible).Copy _
            wb_destination.Range("A5")    Wb_source.Close False

Sais tu d'où vient le problème?

C'est

Code:

1
2
3
wS_destination.Range("A5")    
 
Wb_source.Close False

04/12/2013, 12h08
Rob's

Ca fonctionne!!! :lol:

Merci pour ton aide!