Etirer une cellule avec une macro
Bonjour, j’espère avoir une réponse de votre part, car je ne trouve pas la réponse.
j'ai exposer mon probleme dans le fichier excel que j'ai joint.
J’espère que je suis clair dans ma problématique, sinon demander moi.
Merci
Bonjour,
Une piste, résultat en colonnes de A à F à partir de la ligne 1 :
Sub Test()
Dim Tbl
Dim I As Integer
Dim J As Integer
Tbl = Array("RO", 1, 2, 3)
'en colonnes A à D
For I = 0 To UBound(Tbl)
Cells(1, I + 1).Value = Tbl(I)
Cells(1, I + 1).AutoFill Range(Cells(1, I + 1), Cells(99, I + 1)), 1
Next I
J = Tbl(UBound(Tbl))
'en colonne E et F
For I = 1 To 99 Step 12
J = J + 1
Cells(I, 5).Value = J
Cells(I, 5).AutoFill Range(Cells(I, 5), Cells(I + IIf(I = 97, 2, 11), 5)), 1
Cells(I, 6).Value = 1
Cells(I, 6).AutoFill Range(Cells(I, 6), Cells(I + IIf(I = 97, 2, 11), 6)), 9
Next I
End Sub
Bonjour Tizi,
Si j'ai bien compris ton pb, je te propose :
Option Explicit
Sub Main_Process()
Const cColFirst = 30 ' A adapter suivant l'endroit où l'on veut le résultat
Const cNbIterations = 99
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
Dim lColori As Long, lColorj As Long, lColork As Long, lColorl As Long, lColorm As Long
Dim lRow As Long
Dim oRange As Excel.Range
Dim oSheet As Excel.Worksheet
i = 1
j = 2
k = 3
l = 4
m = 1
Set oSheet = ThisWorkbook.Worksheets(1)
Set oRange = oSheet.Cells(1, 2)
lColori = oRange.Interior.Color
Set oRange = oSheet.Cells(1, 3)
lColorj = oRange.Interior.Color
Set oRange = oSheet.Cells(1, 4)
lColork = oRange.Interior.Color
Set oRange = oSheet.Cells(1, 5)
lColorl = oRange.Interior.Color
Set oRange = oSheet.Cells(1, 6)
lColorm = oRange.Interior.Color
Do Until i > cNbIterations
Do Until j > cNbIterations
Do Until k > cNbIterations
Do Until l > cNbIterations
For m = 1 To 12
lRow = lRow + 1
Set oRange = oSheet.Cells(lRow, cColFirst)
oRange.Value = "RO"
Set oRange = oSheet.Cells(lRow, cColFirst + 1)
oRange.Value = Min(i, cNbIterations)
oRange.Interior.Color = lColori
Set oRange = oSheet.Cells(lRow, cColFirst + 2)
oRange.Value = Min(j, cNbIterations)
oRange.Interior.Color = lColorj
Set oRange = oSheet.Cells(lRow, cColFirst + 3)
oRange.Value = Min(k, cNbIterations)
oRange.Interior.Color = lColork
Set oRange = oSheet.Cells(lRow, cColFirst + 4)
oRange.Value = Min(l, cNbIterations)
oRange.Interior.Color = lColorl
Set oRange = oSheet.Cells(lRow, cColFirst + 5)
oRange.Value = m
oRange.Interior.Color = lColorm
Next
l = l + 1
Loop
l = cNbIterations
k = k + 1
Loop
k = cNbIterations
j = j + 1
Loop
j = cNbIterations
i = i + 1
Loop
Set oRange = Nothing
Set oSheet = Nothing
End Sub
Function Min(zi As Integer, zMax As Integer) As Integer
If zi < zMax Then
Min = zi
Else
Min = zMax
End If
End Function
Bien cordialement,
GVS