Discussion :

[Mike March]

Bonjour
J'ai encore une question vba
j'ai préparer ce code mais pas de solution exacte :
je m'explique :

-> classeur A (fermé) contient les données à mettre à jour (onglet fixe "Donnees").
-> calsseur B (ouvert) a un feuille ("Donnees") que je dois mettre a jour (mais le nom de la feuille doit rester le même). Pas "Donnees (x)"
bout de code

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
 
Sub b()
Dim objSh, objFic, Fic2Open$, WBKSource As Workbook
Dim nom As String
Dim i As Integer
 
 
nom = "donnees"
Set objSh = CreateObject("Shell.Application")
MsgBox "Sélectionner le fichier dans le répertoire adéquat contenant la source données des communes (en XLS) "
Set objFic = objSh.BrowseForFolder(&H0&, "Sélectionner le fichier dans le répertoire adéquat", &H4000&)
Fic2Open = objFic.ParentFolder.ParseName(objFic.Title).Path & ""
Set WBKSource = Workbooks.Open(Fic2Open)
i = 1
If i = 1 Then
MsgBox "Effacement de l'ancienne fiche de données "
WBKSource.Sheets(nom).Copy Before:=ThisWorkbook.Sheets(nom)
MsgBox "Effacement de l'ancienne fiche de données "
 
Else: Sheets("donnees").Delete
End If
 
WBKSource.Close False
End Sub

J'ai peut être zapppé une étape....
Merci par avance

[EricDgn]

Bonjour,

Une façon de faire:

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
Option Explicit
 
Sub b()
   Dim Fic2Open As String, WBKSource As Workbook, nom As String
   '--- sélection fichier
   With Application.FileDialog(msoFileDialogFilePicker)
      .AllowMultiSelect = False           '--- 1 seul fichier
      .InitialFileName = ThisWorkbook.Path
      .Title = "Sélectionner 1 fichier"
      .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
      If .Show = -1 Then
         Fic2Open = .SelectedItems.Item(1)
      Else
         Fic2Open = ""
      End If
   End With
   '--- copie données
   If Fic2Open = "" Then
      MsgBox "Aucun fichier sélectionné", , "Pour info"
   Else
      nom = "Donnees"
      Set WBKSource = Workbooks.Open(Fic2Open)
      On Error Resume Next
      WBKSource.Sheets(nom).Cells.Copy ThisWorkbook.Sheets(nom).Range("A1")
      If Err.Number = 0 Then
         On Error GoTo 0
         If MsgBox("Supprimer la feuille " & nom & vbLf & _
                   "du fichier " & Fic2Open & " ?" & vbLf & _
                   "(suppression définitive, non récupérable)", vbYesNo, "A confirmer") = vbYes Then
            Application.DisplayAlerts = False
            WBKSource.Sheets(nom).Delete
            Application.DisplayAlerts = True
            WBKSource.Close True
         Else
            WBKSource.Close False
         End If
      Else
         On Error GoTo 0
         MsgBox "Pas de feuille '" & nom & "'" & vbLf & _
                "dans le fichier " & Fic2Open & " !", , "Pour info"
         WBKSource.Close False
      End If
      Set WBKSource = Nothing
   End If
End Sub

Bonne continuation.

[Mike March]

Bonjour Le forum, et à vous grand merci pour votre aide.
Cependant il reste la partie à voir
Classeur A (ouvert et à mettre a jour) la feuille ''donnees'' doit être effacée si elle existe dans le classeur B.
Classeur B (on copie) mais on n'efface pas la feuille ''donnees" car elle sert à plusieurs mise à jour à d'autres utilisateurs.
Merci par avance
Et belles fêtes de fin d'années à tous

[EricDgn]

Bonjour,

Dans ce cas, ceci pourrait convenir:

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
Sub b()
   Dim Fic2Open As String, WBKSource As Workbook, wSh As Worksheet
   Dim sNom As String, bNom As Boolean
   '--- sélection fichier
   With Application.FileDialog(msoFileDialogFilePicker)
      .AllowMultiSelect = False           '--- 1 seul fichier
      .InitialFileName = ThisWorkbook.Path
      .Title = "Sélectionner 1 fichier"
      .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
      If .Show = -1 Then
         Fic2Open = .SelectedItems.Item(1)
      Else
         Fic2Open = ""
      End If
   End With
   If Fic2Open = "" Then
      MsgBox "Aucun fichier sélectionné", , "Pour info"
   Else
      '--- aller sur feuille sNom
      sNom = "Donnees"
      bNom = False
      For Each wSh In ThisWorkbook.Worksheets
         If wSh.Name = nom Then bNom = True
      Next wSh
      If bNom = True Then
         ThisWorkbook.Worksheets(sNom).Select
         Cells.Clear '--- vide la feuille existante
      Else
         Worksheets.Add().Name = sNom
      End If
      '--- copier données
      Set WBKSource = Workbooks.Open(Fic2Open)
      For Each wSh In WBKSource.Worksheets
         If wSh.Name = nom Then bNom = True
      Next wSh
      If bNom = True Then
         WBKSource.Sheets(nom).Cells.Copy ThisWorkbook.Sheets(nom).Range("A1")
      Else
         MsgBox "Pas de feuille '" & nom & "'" & vbLf & _
                "dans le fichier " & Fic2Open & " !", , "Pour info"
      End If
      WBKSource.Close False
      Set WBKSource = Nothing
   End If
End Sub

Bonne continuation.

[Mike March]

Bonjour Merci pour votre aide.
Je n'arrive pas a copier dans ma procédure. Cela plante.
Elle copie une feuille dans le classeur destination au nom de Donnees, mais vide.