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