Copier coller a partir d'un msgbox qui selectionne le fichier à coller

Version imprimable

04/11/2014, 08h30
MichaelM

Copier coller a partir d'un msgbox qui selectionne le fichier à coller

Bonjour à tous,

Je suis nouveaux sur le forum, donc si je manque aux règles qui régissent ce site, n'hésitez pas à m'en faire part.

J'ai un besoin de developpement VBA pour mon activité professionnelle. Pour info, j'ai un niveau débutant en VBA.

Mon besoin :

j'ai un fichier "central" et je reçois chaque mois, un fichier de "base".

Mon fichier central est à destination d'une population peu averti sur excel, d'où l'utilisation de VBA pour leur faciliter la vie.

1/ Je souhaiterais un bouton, en feuille 1 du fichier "central" par lequel, j'ouvre un Msgbox qui me donne la possibilité de séléctionner un fichier. (en gros un parcourir...)

2/ Une fois ce fichier selectionné, il copie la feuille 1 de ce fichier "de base" pour la coller dans la feuille 2 du fichier "central"

3/ Un mois plus tard, j'ai la même manipulation a effectuer, mais je colle les nouvelles données du nouveau fichier "de base" sous les anciennes données déjà présentes dans le fichier "central" en feuille 2.

Voilà j'espère que tout est clair, j'ai besoin de vos compétences.

Merci d'avance à tous ceux qui m'apporteront cette aide.

Bonne fin de journée.

Michael
04/11/2014, 09h02
Nako_lito

Une question avant que tu te lance dans ton truc, les données copiées sont elles nombreuses ? Car sur le long terme, si ton fichier commence a peser plusieur 10aine, voir 100aine de méga octets, ca va poser des problème de lenteurs.

Sinon, tu créé un module qui reprend les étapes que tu as dis toi même. Tu trouveras des exemples de code pour tout ce que tu demande sur internet, et très facilement qui plus est.
Nous n'allons pas te faire ton code, par contre, nous pouvons t'aider à le comprendre et t'aider a debbuger si ça plante.

Créer un bouton d'action sur une feuille de calcul excel

Ces recherches m'ont pris environ 30 secondes sur google. Et ça ne requiers pas de compétences technique que de rechercher.

Bonjour le fil, bonjour le forum,

Heu, désolé Nako_lito mais j'ai une autre approche de la manière d'aider. Je sais qu'elle est discutable mais c'est comme ça que j'agis. Je commente les codes pour que les gens les comprennent et que ça leur donne peut-être envie d'aller au-delà... J'espère que tu ne m'en voudras pas.
Le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (celllule de DESTination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets(2) 'définit l'onglet destination OD
'définit la cellue de destination DEST (A1'si A1 est vide, sinon la première ligne vide de la colonne 1 (=A) de l'onglet OD)
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
If Application.Dialogs(xlDialogOpen).Show = True Then 'condition : si un fichier est sélectionné dans la boîte de dialogue "Ouvrir"
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Sheets(1) 'définit l'onglet source OS
    OS.UsedRange.Copy DEST 'copie la plage des cellules utilisées de l'onglet OS et la colle dans dest
    CS.Close SaveChanges:=False 'ferme le classeur source sans enregister
    ThisWorkbook.Save 'sauve ce classeur
End If 'fin de la condition
End Sub

Bonjour,

Allez, j'y vais de quelques contributions pour donner quelques pistes également ....

1. Fonction d'extract de date (utilité: créer par exemple une feuille basée sur le mois en cours)

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
 
Function Extr_DatePart(ByVak InputDate As Date, ByVal ExtrType As String, Optional AddYear As Boolean = True) As String
' Return the date part of a date
 
Dim DatePartS As String
 
If AddYear = True Then DatePartS = DatePart("yyyy", InputDate)
 
Select Case ExtrType
 
    Case "y", "Y"
        If AddYear = False Then DatePartS = DatePart("yyyy", InputDate)
    Case "q", "Q"
        DatePartS = DatePartS & "_Q" & DatePart("q", InputDate)
    Case "m", "M"
        DatePartS = DatePartS & Format(DatePart("m", InputDate), "00")
    Case Else
        DatePartS = Format(InputDate, "YYYYMMDD")
 
End Select
 
Extr_DatePart = DatePartS
 
End Function

2. Test existance s'un sheet / création

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
 
Function Exist_Wsh(Wbk As Workbook, WshName As String, Optional CreateSh As Boolean = False, Optional Prompt_creat As Boolean = False, Optional TabCol As Variant = vbCyan) As Boolean
'=============================================================================
' Check if a sheet exists by an access and create it if not (optional)
 
    Funcname = "Exist_Wsh"
 
    Dim Msgansw As String, Wsh As Worksheet
 
    If IsMissing(Wbk) Then Set Wbk = ActiveWorkbook
 
    On Error GoTo Err_notexist
 
        ' Set the default values
    Exist_Wsh = False
 
        ' Test by access to the sheet, return true if succeeded, or test the Error 9
    If Wbk.Worksheets(WshName).Range("A1").Address <> "" Then Exist_Wsh = True
 
Err_notexist:
 
        ' Expected Error raised when accessing to a not existing sheet
    If err.Number = 9 Then
 
        err.Clear
 
        Msgansw = vbOK
 
            ' Create if CreateSh = True with or without user confirmation depending on Prompt_creat
        If CreateSh = True Then
 
            If Prompt_creat = True Then
                Msgansw = MsgBox("The sheet " & WshName & " doesn't exist" & " in workbbok " & Wbk.Name & vbCrLf & _
                    "Would you like to create it?", vbExclamation + vbOKCancel, Funcname)
            End If
 
                ' Create it if not existing depending on users inputs or option
            If Msgansw <> vbCancel Or Prompt_creat = False Then
 
                Set Wsh = Wbk.Worksheets.Add(After:=Wbk.Worsheets(Wbk.Worksheets.Count))
                Wsh.Name = WshName
                Debug.Print VarType(Wsh.Tab.Color)
                Wsh.Tab.Color = TabCol
 
                    ' Test by access to the sheet, return true if succeeded
                If Wsh.Range("A1").Address <> "" Then Exist_Wsh = True
 
            End If
 
        End If
 
        err.Clear
 
            ' Return false if another error
    Else:
        If err.Number > 0 Then
            MsgBox "Error: " & err.Number & vbCrLf & err.Description, vbCritical, Funcname
            Exist_Wsh = False
            err.Clear
        End If
    End If
End Function

3. Retourne une collection de feuilles dont le nom contients un certain caractère

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Function GetWshList(Wbk As Workbook, WshN As String) As Variant
' Return a collection of Worhsheets name matching the WshN String
 
Dim Wsh As Worksheet
Dim WshNC As New Collection
 
If IsMissing(Wbk) Then Set Wbk = ActiveWorkbook
 
For Each Wsh In Wbk.Worksheets
    If InStr(1, Wsh.Name, WshN, vbTextCompare) > 0 Then WshNC.Add Wsh.Name
Next Wsh
 
Set GetWshList = WshNC
 
End Function

et .... ne pas oublier le Application.FileDialog pour ouvrir un fichier avec interface .... surtout pas un Msgbox.

Bons essais :)
Vincent

04/11/2014, 10h13
MichaelM

Merci à tous pour votre réactivité,

Je test et je vous fais un retour très vite !
04/11/2014, 12h43
Nako_lito

c'est pas que je veux pas aider ou faire le travail des autres, c'est simplement que je suis partisan des têtes bien faites plutôt que des tête bien pleine mais plutôt orienté vers des citation du genre "pêche pour qqn, il mangera un jour, apprends lui a pêcher, il mangera toute sa vie".

Comme j'ai dis, si MichaelM a besoin d'aide pour comprendre qqc, pas de soucis.
04/11/2014, 13h44
Thautheme

Bonjour le fil, bonjour le forum,

J'avais bien compris, Nako_lito, et je comprends très bien ton point de vue. Je ne voulais pas que tu m'en veuilles de proposer une solution derrière ta remarque...
04/11/2014, 13h46
Nako_lito

nullement tkt pas ^^
05/11/2014, 11h40
MichaelM

La solution de Thautheme fonctionne parfaitement bien et répond exactement à mon problème .

Merci bcp !