VBA- Creation tableau à partir de cellules de plusieurs feuilles

**29NONO29** · 26/10/2009, 14h35

Bonjour à tous !
Bon je tiens à preciser que je suis debutant en VBA et c'est pourquoi j'aurais besoin de votre aide!
Pour commencer voici les etapes que j'ai realisées:
J'ai fait un userform: - un bouton permet d'ouvrir un .csv de mon choix
- j'enregistre manuellement et toujours au meme endroit le fichier au nom de "Book2.xls"
- un bouton permettant de copier des cellules d'un fichier"trame.xls"(contenant un tableau avec des formules pour sortir des données interressantes) vers "Book2.xls"
- un bouton save permettant de sauvegarder mon fichier "Book2.xls" à la date d'aujourd'hui dans un fichier spécifié, qui sera donc nommée "Ticket_DD_MM_YYYY"

Donc le but de toute cette interface est de permettre (facilement

) l'importation de donnée a partir d'un serveur et de voir l'evolution de la charge de travail au jour le jour. L'evolution etant carcaterisé par 2 cellule creer a partir de la fusion de trame.xls et de Book2.xls

Et maintenant ce que je souhaite faire, c'est un bouton me permettant d'aller copier 2 cellules definies(AV2, AV3)de tous les fichiers excels "Ticket_DD_MM_YYYY" d'un dossier et de les coller dans un autre classeur existant nommée "evolution.xls" . Dans ce "evolution.xls" il y a deja un graphique qui me donnera l'evolution.

J'espere que tout le monde me suit et que quelqu'un trouvera reponse à mon probleme.

Voila je met tout mon code (il y a peut etre des simplifications possibles):

J'ai donc une erreur au niveau du rouge pour l'importation
====================================================================================

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
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Private Sub CommandButton6_Click()


    Workbooks.Open Filename:="U:\Helpdesk\Source\evolution.xls"
    Workbooks("evolution.xls").Activate
Dim Classeur As Workbook, ColSuiv
With Application.FileSearch
    .LookIn = "U:\Helpdesk\Save"
    .SearchSubFolders = False
    .Filename = "*.xls"
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
          Set Classeur = GetObject(.FoundFiles(i))
          ColSuiv = Range("IV1").End(xlToLeft).Column + 1
          Classeur.Sheet(1).Range("AV2:AV3").Copy ThoseWorkbooks.Sheets(1).Cells(1, ColSuiv)
        Next i
    End If
End With
End Sub
====================================================================================
Private Sub CommandButton1_Click()
'
Dim F As Variant
  
F = Application.GetOpenFilename("csv Files (*.csv), *.csv")
  
If F = False Then Exit Sub
 
Workbooks.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & F, Destination _
        :=Range("$A$1"))
        .Name = "fichier_client"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        End With
        
 
    Rows("1:1").Select
    Selection.Font.Bold = True
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Columns("A:AM").EntireColumn.AutoFit
 
End Sub
====================================================================================
Private Sub CommandButton2_Click()
Unload DK_Helpdesk
End Sub
====================================================================================
Private Sub CommandButton3_Click()

Workbooks.Open Filename:="U:\Helpdesk\Source\trame.xls"
Dim MaPlage As Range
With Workbooks("trame.xls").Worksheets("Data")
    Set MaPlage = Application.Union(.Range("AN1:AO5000"), .Range("AP1:AV5000"))
End With
MaPlage.Copy
Workbooks("Book2.xls").Worksheets("Sheet1").Activate
Range("AN1").Select
 
  ActiveSheet.Paste
Workbooks("trame.xls").Close False
Workbooks("Book2.xls").Activate

ChDir "U:\Helpdesk"
    ActiveWorkbook.SaveAs Filename:="U:\Helpdesk\Book2.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
MsgBox "Ok"
End Sub
====================================================================================
Private Sub CommandButton4_Click()

monfichier = "U:\Helpdesk\Save\Ticket"
   
If Dir(monfichier & ".xls") <> "" Then
jour = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & "." & Minute(Now) & "." & Second(Now)
monfichier = monfichier & " " & jour
End If
monfichier = monfichier & ".xls"

Workbooks("Book2.xls").Activate
ActiveWorkbook.SaveAs monfichier
MsgBox "Sauvegarde terminée."
End Sub
====================================================================================

Private Sub CommandButton5_Click()
TextBox1.Value = Sheets("Sheet1").Range("AV2").Value
End Sub

====================================================================================

MERCI POUR VOTRE AIDE

Arnaud

**Krovax** · 26/10/2009, 14h41

Bonjour,
Premièrement quand tu donne un code utilise les balise CODE pour être lisible. Du coup je me suis contenté de regarder la ligne rouge

ThisWorkbook et non ThoseWorkbooks
Ou alors je ne voi pas ce que tu cherches a faire en passant au pluriel

Edit : Oui premier croisé pour mon retour Bonjour Aalex

**aalex_38** · 26/10/2009, 14h42

Bonjour,

tout d'abord pense a ajouter la balise code # sinon c'est dur à lire.

En rouge c'est ThisWorkbook et non pas ThoseWorkbooks.

Pour vérifier la syntaxe en cours de developpement, met option explicit en début de module.

Edit : bonjour Krovax, ça fait plaisir de te voir de retour !

**29NONO29** · 26/10/2009, 14h49

Merci pour vos réponses rapides mais je rencontre toujours un probleme apres remplacement à la meme ligne : Run-Time error '438'
Object doesn't support this property or method

**Krovax** · 26/10/2009, 15h55

Pas de réponse je tente donc ma chance

Code :

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

Set Classeur = GetObject(.FoundFiles(i))

Je ne suis pas sur que classeur corresponde bien a un classeur excel ouvert. Pour moi il correspond a un classeur mais fermé
Tu peux faire

Code :

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

msgbox classeur.sheets(1).range("A1")

Si ca fonctionne c'est que j'ai du taper a coté sinon je ne doit pas être loin. Ouvre ton fichier et ensuite travail dessus ou passe par les classeur fermé (regarde les tutos a ce sujet)

**29NONO29** · 26/10/2009, 16h04

J'ai essayé de faire ce que tu dis mais je ne vois pas ou tu veux en venir avec :

Code :

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

msgbox classeur.sheets(1).range("A1")

**Krovax** · 26/10/2009, 16h06

Ben si la ligne de code fonctionne ca veux dire que effectivement tu peux travailler sur l'objet classeur comme tu le fais sinon cela signifie que tu ne peux pas et que tu va devoir commencer par l'ouvrir

**29NONO29** · 26/10/2009, 16h17

Oui le code fonctionne, il me renvoi bien ce qui est indiqué dans la cellule A1 de Book2.xls

**Krovax** · 26/10/2009, 16h20

Bon dans ce cas on va voir si on a un problème à la copi ou au collage on finira bien par trouver

Code :

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

1
2
Classeur.Sheet(1).Range("AV2:AV3").Copy 
ThisWorkbook.Sheets(1).Cells(1, ColSuiv).paste

**29NONO29** · 26/10/2009, 16h25

Maintenant il me renvoi une erreur sur :

Code :

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

Classeur.Sheet(1).Range("AV2:AV3").Copy

...
Merci pour ton aide !

**aalex_38** · 26/10/2009, 16h36

Il manque un s a sheet, option explicit en haut du module pour éviter ce genre d'erreur.

**29NONO29** · 26/10/2009, 16h45

Oui...c'est corrigé

Par contre maintenant je n'ai plus d'erreur mais il copie Book2.xls alors que je ne veux pas Book2. xls mais les .xls qui se trouve dans le repertoire indiqué.En plus il copie Book2.xls dans mon fichier source, celui ou j'ai créé la macro et non dans evolution.xls... je ne comprend vraiment plus rien...Je pensait que la fonction "Application.FileSearch" permettait de faire ça???

Revoici le

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
Private Sub CommandButton6_Click()
 
 
    Workbooks.Open Filename:="U:\Helpdesk\Source\evolution.xls"
    Workbooks("evolution.xls").Activate
Dim Classeur As Workbook, ColSuiv
With Application.FileSearch
    .LookIn = "U:\Helpdesk\Save"
    .SearchSubFolders = False
    .Filename = "*.xls"
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
          Set Classeur = GetObject(.FoundFiles(i))
          ColSuiv = Range("IV1").End(xlToLeft).Column + 1
          Classeur.Sheets(1).Range("AV2:AV3").Copy ThisWorkbook.Sheets(1).Cells(1, ColSuiv)
        Next i
    End If
End With
End Sub

**29NONO29** · 27/10/2009, 14h36

RE,
j'ai peut etre trouvé une 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
Dim f As String, myf As Worksheet
ChDir "U:\Helpdesk\Save"
Application.ScreenUpdating = False
Set myf = Sheets.Add(before:=Sheets(1))
f = Dir("*.xls")
Do While Len(f) > 0
Workbooks.Open (f)
ActiveWorkbooks.Sheets(1).[AV8:AV9].Copy
Destination:=myf.[b65536].End(xlUp)(2)
myf.[a65536].End(xlUp)(2) = f
Workbooks(f).Close False
f = Dir
Loop
Application.ScreenUpdating = True
End Sub

C'est un code que j'ai trouvé sur le net, cependant j'ai une erreur sur "Destination:=myf.[b65536].End(xlUp)(2)", Quelqu'un aurait la soluce??
je pense que cela vient du myf ???Une idée pour ne pas copier les valeurs dans une nouvelle feuille mais dans une feuille existante??

VBA- Creation tableau à partir de cellules de plusieurs feuilles

Macros et VBA Excel

Discussions similaires

Partager

Partager