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
| Option Explicit
Sub test()
Dim WB_Commande As Workbook
Dim WS_Rapport As Worksheet
Dim RgTotaux As Range
Dim iOffsetColCmd As Integer, iOffsetRowRegroupe
Dim iOffsetColRegroupement As Integer
'On crée un onglet pour y mettre la rapport
Set WS_Rapport = ThisWorkbook.Worksheets.Add
'On y place la date et l'heure
WS_Rapport.Range("A1").Value = Format(Date + Time, "dd/MM/yy hh:mm:ss")
'On défini la 1ère colonne qui recevra les données
iOffsetColRegroupement = 1
'Provisoirement on défini le classeur contenant les données à ajouter
'Il faudra par la suite inclure le code dans une boucle
'ou tout autre système permettant de pointer les fichiers à importer
Set WB_Commande = Workbooks("Copie de Rapport Test.xlsm")
'On pointe la feuille à importer, on considére que c'est toujours la 1ère feuille
With WB_Commande.Sheets(1)
'On recherche la ligne contenant les totaux
Set RgTotaux = .Columns("A").Find("Total", , xlValues, xlWhole, MatchCase:=False)
'On vérifie qu'une cellule a été trouvée
If Not RgTotaux Is Nothing Then
'Ici pour personnaliser la 1ère ligne de la colonne qui va recevoir les données (N° de Container)
'A adapter
WS_TDB.Cells(1, iOffsetColRegroupement + 1).Value = Left(.Range("A1").Value, 13)
'On copie la ligne OK dont on ne prend que 2 lignes (B20:B21)
'WS_TDB correspond au code name de la feuille TDB
RgTotaux.Offset(, 1).Resize(2, 1).Copy WS_TDB.Range("A3:A4").Offset(, iOffsetColRegroupement)
WS_TDB.Range("A3:A4").Offset(, iOffsetColRegroupement).Value = RgTotaux.Offset(, 1).Resize(2, 1).Value
'On boucle ensuite sur les 7 autres colonnes pour copier les 3 lignes
For iOffsetColCmd = 2 To 9
'On défini où vont être placées les données
iOffsetRowRegroupe = (iOffsetColCmd - 2) * 3
'On copie les données
With WS_TDB.Range("A5:A7").Offset(iOffsetRowRegroupe, iOffsetColRegroupement)
'On fait une copie complète pour avoir les formats de cellules
RgTotaux.Offset(, iOffsetColCmd).Resize(3, 1).Copy .Cells
.Value = RgTotaux.Offset(, iOffsetColCmd).Resize(3, 1).Value
End With
Next
'On pointe la colonne suivante
iOffsetColRegroupement = iOffsetColRegroupement + 1
Else
'Pas de totaux
'On ajoute une ligne à la suite du rapport
With WS_Rapport.Range("A1").End(xlDown).Offset(1)
'On met le nom du classeur qui pose problème
.Value = WB_Commande.Name
'On indique la problème
.Offset(, 1).Value = "Pas de ligne de totaux"
End With
End If
End With
End Sub |
Macro copier coller vers la droite si cellule pleine
Répondre avec citation
).
Partager