VBA- Creation tableau à partir de cellules de plusieurs feuilles
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 :whistle: ) 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:
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
