Bonjour a tous
je souhaiterai augmenter la lecture des donées de lla macro suivante qui est limiter a 20 ( 300; 20) j'ai essayer de la modifier en remplaçant 20 par 6000 mais cela ne fonctionne pas
code vba
Public nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
Sheets("Données").Activate
Range("M4").Select
nblignelue = 1
Do
If Year(CDate(ActiveCell.Value)) < Year(Date) Then
If Month(Date) > 3 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
ElseIf (CDate(ActiveCell.Value)) - Month(Date) < 9 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
ElseIf Month(CDate(ActiveCell.Value)) <= (Month(Date) - 3) Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
Selection.Offset(1, 0).Select
Loop While ActiveCell.Value <> ""
Workbooks("base_new.xls").Activate
Sheets("> 3mois").Activate
Range("a2").Select
For i = 1 To nblignelue - 1
For j = 1 To 20
ActiveCell.Value = tableau(i, j)
Selection.Offset(0, 1).Select
Next
Selection.Offset(1, -20).Select
Next
End Sub
Sub test()
ft = MsgBox(Str(GetCol(ActiveCell)), , "TEST")
End Sub
Public Function GetCol(cell As Range) As Integer
GetCol = Val(Right(cell.Address, Len(cell.Address) - InStr(2, cell.Address, "$")))
End Function
je souhaiterai augmenter la lecture des donées de lla macro suivante qui est limiter a 20 ( 300; 20) j'ai essayer de la modifier en remplaçant 20 par 6000 mais cela ne fonctionne pas
code vba
Public nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
Sheets("Données").Activate
Range("M4").Select
nblignelue = 1
Do
If Year(CDate(ActiveCell.Value)) < Year(Date) Then
If Month(Date) > 3 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
ElseIf (CDate(ActiveCell.Value)) - Month(Date) < 9 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
ElseIf Month(CDate(ActiveCell.Value)) <= (Month(Date) - 3) Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
Selection.Offset(1, 0).Select
Loop While ActiveCell.Value <> ""
Workbooks("base_new.xls").Activate
Sheets("> 3mois").Activate
Range("a2").Select
For i = 1 To nblignelue - 1
For j = 1 To 20
ActiveCell.Value = tableau(i, j)
Selection.Offset(0, 1).Select
Next
Selection.Offset(1, -20).Select
Next
End Sub
Sub test()
ft = MsgBox(Str(GetCol(ActiveCell)), , "TEST")
End Sub
Public Function GetCol(cell As Range) As Integer
GetCol = Val(Right(cell.Address, Len(cell.Address) - InStr(2, cell.Address, "$")))
End Function
pourriez vous m'aider
merci de votre aide