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
| Option Explicit
Sub test()
'Tu dois adapter ici pour tenir compte de la bonne feuille et du nombre de colonne
Reorganisation Feuil1, NbrCol:=6
End Sub
Sub Reorganisation(Optional ShtData As Worksheet, Optional Plage As Range, Optional NbrRow As Long, Optional NbrCol As Integer, Optional Limite As String = "")
Dim tiTab As Variant
Dim tiRetour As Variant
Dim xRow As Long, xCol As Integer
Dim iRow As Long, iCol As Integer
Dim WTab As Long
Dim iRetRow As Integer, iRetCol As Long
'On place les données dans un tableau interne
If Not Plage Is Nothing Then
tiTab = Plage.Value
'On prend en compte les limites de la plage donnée
xCol = Plage.Columns.Count
Else
'On cherche les données
With ShtData ' A adapter
'On regarde si des bornes sont imposées
xRow = .Cells(.Rows.Count, "A").End(xlUp).Row + IIf(Limite = "", 1, 0)
xCol = IIf(NbrCol = 0, .Cells(1, .Columns.Count).End(xlToRight).Column, NbrCol)
'On enregistre les données présentes dans un tableau interne
tiTab = .Range("A1", .Cells(xRow, xCol)).Value
End With
End If
'On vérifie qu'il s'agit d'un tableau
If Not IsEmpty(tiTab) Then
If UBound(tiTab) > -1 Then
'On recherche la limite
If NbrRow <> 0 Then
xRow = NbrRow
Else
xRow = 0
iRow = 1
While xRow = 0 And iRow <= UBound(tiTab)
If UCase(tiTab(iRow, 1)) = UCase(Limite) Then xRow = iRow
iRow = iRow + 1
Wend
End If
'On défini le nombre de colonne du tableau retour
WTab = (UBound(tiTab)) / xRow
'On redimensionne le tableau
ReDim tiRetour(1 To xRow, 1 To (WTab * xCol))
'On initialise les variables qui pointe la case cible de tiRetour
iRetRow = 1
iRetCol = 1
'On boucle si tiTab
For iCol = 1 To UBound(tiTab, 2)
For iRow = 1 To UBound(tiTab)
'On inscrit
tiRetour(iRetRow, iRetCol) = tiTab(iRow, iCol)
'On pointe la ligne suivante
iRetRow = iRetRow + 1
'Si on dépasse le nombre de ligne, on retourne à la 1ère, on passe à la colonne suivante
If iRetRow > UBound(tiRetour) Then
iRetRow = 1
iRetCol = iRetCol + xCol
End If
Next
'On remplace le pointeur sur la 1ère ligne
iRetRow = 1
'On repositionne le pointeur de colonne
iRetCol = iCol + 1
Next
'On crée une nouvealle feuille
With ThisWorkbook.Worksheets.Add
.Range("A1").Resize(UBound(tiRetour), UBound(tiRetour, 2)).Value = tiRetour
End With
End If
End If
End Sub |
Reformater un fichier Excel "étrange"
Répondre avec citation
, ça fait toujours plaisir...
Tutoriel : 
Envoyé par mfoxy
Partager