Dépassement de capacité

Bonjour,

1/ pour avoir la derniere cellule non vide d'une colonne, sans boucle infernale:

c= Range("A" & Rows.Count).End(xlUp).Row

2/ Et ensuite j'ai : comment passez vous la variable c d'une procedure a l'autre et vous l'avez declare de quel type

Bonjour
comme on ne connait pas la déclaration de tes variables b et c...
et comment implémente tu "c "
car tu dis
Ce bout de code est dans une autre ...

Sub extraction()
' Récupérer la taille du tableau final après extraction
c = 0
While Range("A1").Offset(c, 0) <> ""
c = c + 1
Wend

' Appel des fonctions
Call ColonneCmdReel(c)
Call Date(c)

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ColonneCmdReel(c)

Set wb = ActiveWorkbook
ExtractDir = ActiveWorkbook.Path & "\YMMRPT011\"
Dim NomOngletInputs As String
NomOngletInputs = "Inputs011"

wb.Activate
wb.Worksheets(NomOngletInputs).Activate

' Opération sur colonne cmdé réel
For b = 2 To c + 1
If Cells(b, 8).Value = 0 Then
Cells(b, 14).Value = Cells(b, 7).Value
Else: Cells(b, 14).Value = Cells(b, 9).Value
End If
Next b

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Je sais pas si cela suffit.
J'ai essayé cette méthode :

For Each cel In Range(Range("A2"), Range("A65000").End(xlUp))
If cel.Offset(0, 7).Value = 0 Then
cel.Offset(0, 13).Value = cel.Offset(0, 6).Value
Else: cel.Offset(0, 13).Value = cel.Offset(0, 8).Value
End If
Next cel

Ca marche pour cette fonction mais par exemple pour une autre fonction j'avais ça :
Sub Date(c)
For b = 2 To c + 1
Cells(b, 15).Value = Format(Cells(b, 12).Value, "yyyy")
Next b
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
J'ai remplacé par :
For Each cel In Range(Range("A2"), Range("A65000").End(xlUp))
cel.Offset(0, 14).Value = Format(cel.Offset(0, 11).Value, "yyyy")
Next cel
Ca ne me met pas le bon format que je souhaite.....

Re,

essayez ceci:

Sub extraction()
    Dim NomOngletInputs As String, plage As Range, cel As Range, b As Long

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    ExtractDir = ActiveWorkbook.Path & "\YMMRPT011\"
    NomOngletInputs = "Inputs011"

    wb.Activate
    wb.Worksheets(NomOngletInputs).Activate

    ' Opération sur colonne cmdé réel
    Set plage = Range(Range("A2"), Range("A65000").End(xlUp))
    For Each cel In plage
        If cel.Offset(0, 7).Value = 0 Then
            cel.Offset(0, 13).Value = cel.Offset(0, 6).Value
        Else
            cel.Offset(0, 13).Value = cel.Offset(0, 8).Value
        End If
        'format date annee
        b = cel.Row
        Cells(b, 15).Value = Format(Cells(b, 12).Value, "yyyy")
    Next cel
    Application.ScreenUpdating = True
End Sub

Bonjour,

un peu plus rapide (65000 ligne en 0.9 s au lieu de 4s)

Option Base 1

Sub extraction()
    Dim NomOngletInputs As String, plageA As Range, cel As Range, b As Long
    Dim Tcol13, Tcol15, c


    temps = Timer

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    ExtractDir = ActiveWorkbook.Path & "\YMMRPT011\"
    NomOngletInputs = "Inputs011"

    wb.Activate
    wb.Worksheets(NomOngletInputs).Activate
    ' Opération sur colonne cmdé réel
    derlig = Range("A65536").End(xlUp).Row
    'redefini les tableaux fonction fin cellule non vide
    ReDim Tcol13(derlig - 1), Tcol15(derlig - 1)
    'mise en memoire colonne A
    Set plageA = Range("A2:A" & derlig)
    'boucle colonne A pour mise en tableaux des valeurs
    For Each cel In plageA
        b = cel.Row: c = b - 1
        If cel.Offset(0, 7).Value = 0 Then
            Tcol13(c) = cel.Offset(0, 6).Value
        Else
            Tcol13(c) = cel.Offset(0, 8).Value
        End If
        Tcol15(c) = Year(Cells(b, 12))
    Next cel
    'restitution des valeurs
    With wb.Worksheets(NomOngletInputs)
        .Range("N2:N" & derlig) = Application.Transpose(Tcol13)
        .Range("O2:O" & derlig) = Application.Transpose(Tcol15)
    End With
    Application.ScreenUpdating = True
    
    MsgBox "temps: " & Timer - temps
End Sub