Discussion :

[Pagale]

Bonjour à tous,

Je suis débutant en informatique et programmation et je galère sur VBA.

Je m'explique, j'ai une feuille Excel (anthropo) avec un certain nombre de variables (e.g Age, Masse, Taille, Masse musculaire etc...) et un certain nombre d'ID (e.g S1,S2,S3,S4 etc...). J'aimerai faire une fiche "Results" dans une autre feuille Excel (quelque chose de plus "propre" qui résumé toutes les informations d'un sujet).

Je voudrais automatiser tout ça pour qu'une macro aille cherche par exemple la valeur "B3" sur la feuille anthropo et la colle sur la feuille "Results" en C4 par exemple. J'aimerai que ça le fasse automatiquement pour chaque ID (S1,S2,S3 etc...) à la suite et qu'un nouveau Classeur Excel soit enregistré pour chaque ID (avec comme nom "S1_Results" par exemple) avant de passer à un autre.


Voici le début de code que j'ai fait :

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
Sub Report_Results()
'
' Report_Results Macro
'
 
Dim rng As Range
Dim row As Range
Dim cell As Range
 
Sheets("Results").Select
 
Set rng = Range("A1:BG39")
 
For Each row In rng.Rows
 
 
    Range("I3").Select
    Selection.Copy
    Sheets("Results").Select
    Range("E6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Sheets("anthropo").Select
    Range("J3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Results").Select
    Range("E8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
' Enregistrer la fiche "Results" dans un nouveau classeur pour chaque sujet
 
Dim WB As Workbook
Dim Nom$
 
Nom$ = Sheets("Results").[g2]
If Nom$ = "" Then Nom$ = "Results_E1_USAM"
Set WB = Workbooks.Add(xlWBATWorksheet)
 
ThisWorkbook.Sheets("Results").Copy Before:=WB.Sheets(1)
Application.DisplayAlerts = False
WB.Sheets(2).Delete
Application.DisplayAlerts = True
 
WB.SaveAs Filename:="C:\Users\paulg\Desktop\Data_Anthony\" & Nom$ & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
WB.Close SaveChanges:=False
 
Next row
 
 
End Sub

J'espère avoir été clair !

Merci d'avance pour votre aide

[ChristianBosch]

Salut, tu peux préciser sur quels points tu n'arrive pas a développer ton code ?

Car ça me semble assez facile comme manip et de plus si tu décompose ta macro en taches, tu dois assez facilement trouver de l'info sur les forums.

En suite évite le "le copier/coller" en vba fais plutôt :

Cellule que tu veux implémenter = valeur a implémenter

exemple :

Code :

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

Feuil1.range("a4")=feuil2.range("b2").value

Déjà ça va simplifier ton code.

A+

CB

[Pagale]

Salut,

Finalement j'ai réussi à trouver une solution. En tout cas, merci pour l'aide et pour le "copier/coller", je le changerai

Voici le 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
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
Sub Report_Results()
'
' --------------------------- Report_Results Macro -----------------------------------------
 
 
' --------------------------- Racourci Macro = "Ctrl + MAJ + W" ----------------------------
 
 
 
' Permet de ne pas faire la Maj des résultats pour chaque sujet
Application.ScreenUpdating = False
 
'Définition de la taille du tableau pour n lignes
 
    Dim N As Long, i As Long
    Sheets("anthropo").Select
    N = Cells(Rows.Count, "A").End(xlUp).row
    For i = 3 To N
 
    ' Je sélectionne la feuille où sont mes données
    ' Je choisis la variable que je veux copier
    ' Je sélectionne la feuille "Resulsts"
    ' Je sélectionne la cellule où je veux coller ma valeur
 
    ' Variable Age
 
    Sheets("anthropo").Select
    Cells(i, "H").Select
    Selection.Copy
    Sheets("Results").Select
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    ' Variable N° Sujet
 
    Sheets("anthropo").Select
    Cells(i, "A").Select
    Selection.Copy
    Sheets("Results").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
 
    ' Sélectionne le nom du sujet (e.g. S2)
 
    subject_name = Range("A2")
 
    ' Ouvre les fichiers de sprints
    ' Attention, il faut changer le chemin en fonction du dossier où se trouve les fichiers de sprints
 
    Workbooks.Open filename:= _
    "C:\Users\paulg\Desktop\RADAR DONNEES\Résutats F-V-P Sprint\Data Acc_" & subject_name & "_Sprint_1.xls"
 
    Windows("Data Acc_" & subject_name & "_Sprint_1").Activate
 
    ' Supprime l'ancien graphique de la feuille "Results"
 
 
    ' Copie le graphique "Relation F-V"
 
    ActiveSheet.ChartObjects("Relations Force-Vitesse-Puissance").Activate
    ActiveChart.ChartArea.Copy
 
    Windows("Antropo_AS.xlsm").Activate
    Sheets("Results").Select
    Range("P11").Select
    ActiveSheet.Pictures.Paste.Select
 
    ' Copie le graphique RF
 
 
 
' Enregistre le fichier pour chaque sujet avec le nom "Results_USAM_E1"
 
Sheets("Results").Select
Dim WB As Workbook
 
Dim Path As String
Dim filename As String
 
 
'Attention , le Path est à changer en fonction du dossier où tu veux mettre les fichiers
 
'Il faut laisser "Results_USAM_" à la fin du chemin
 
Path = "C:\Users\paulg\Desktop\Data_Anthony\Results_USAM_"
'subject_name = Range("A2")
 
Set WB = Workbooks.Add(xlWBATWorksheet)
 
ThisWorkbook.Sheets("Results").Copy Before:=WB.Sheets(1)
Application.DisplayAlerts = False
WB.Sheets(2).Delete
Application.DisplayAlerts = True
 
WB.SaveAs filename:=Path & subject_name & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
WB.Close SaveChanges:=False
 
    ' Passe au prochain sujet
 
    Next i