Version adaptée aux particularités de ton fichier :
Sub Rassembler()
Dim T(), i%, k%, n%
With ActiveSheet.Range("A5:AN500")
'n = WorksheetFunction.CountA(.Cells)
n = .Cells.Count - WorksheetFunction.CountBlank(.Cells)
ReDim T(1 To n, 1 To 1): n = 0
For k = 1 To 40
For i = 1 To 495
'If Not IsEmpty(.Cells(i, k)) Then
If .Cells(i, k) <> "" Then
n = n + 1: T(n, 1) = .Cells(i, k)
End If
Next i
Next k
.Range("AP1:AP" & n).Value = T
End With
End Sub
On ne dimensionne plus en utilisant CountA mais avec CountBlank qui compte les cellules vides et contenant des valeurs "vides" qu'on soustrait du nombre total de cellules (CountIf ne donnerait pas non plus le bon résultat dans ce cas).
Et on teste avec <>"" (qui élimine de la même façon les cellules vides ou contenant des chaînes vides.
Pour ramener la plage à A5:AN500, on met cette plage au lieu de A1:AN500 au départ. Et on modifie la boucle i = 1 to 495 (puisqu'il n'y a plus que 495 lignes). Et pas d'autres modifications car tous les autres adressages réfèrent à cette plage (adressé donc comme si A5 était A1...)
Cordialement.