Bug : objet de classe range a échouer

Bonjour,

Je souhaite selectionner de la cellule 1-1 à la cellule ?-4 (? = dernière ligne écrite de la feuille)

Function selection()
    Sheets(1).Select
    Sheets(1).Activate
    Dim D%
    D = Range("B1048576").End(xlUp).Row
    Range(Cells(1, 1), Cells(D, 4)).Select
    selection.Activate
    selection.Copy
End Function

mais cela me renvoi une erreur à : D = Range("B1048576").End(xlUp).Row

alors que cette fonction à toujours fonctionner je ne comprend pas.

Merci par avance pour votre aide.

Cordialement.

Bonjour,

Ta variable D est déclarée en Integer (%).

Un peu de lecture pour toi :

https://www.excel-pratique.com/fr/vba/variables.php

Essaie ainsi :

Public Function Selection()
Dim D As Long

    With ActiveWorkbook.Worksheets(1)
        D = .Range("B1048576").End(xlUp).Row
        ' ou = .Cells(Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(D, 4)).Copy
    End With

End Function

Merci, pour ta réponse

J'ai une erreur différente là : erreur 1004 erreur défini par l'application ou par l'objet, qui pointe sur

        D = .Range("B1048576").End(xlUp).Row

Et je l'avais placer dans un integer car mes variable ne dépasse jamais les 10.000.

Re,

Il va falloir joindre un fichier à ta demande.

Cdlt.

Voici le code en entier :

Sub Assembler_DG()
    Dim nb%, tmp%, D%
    tmp = 2
    D = 1
    nb = ActiveWorkbook.Sheets.Count
    Call Module1.format(1)
    While tmp <= nb
        Call Module1.format(tmp)
        Call Module1.traitement(tmp, D)
        tmp = tmp + 1
    Wend
    Call Module1.img
    Call Module1.Selection
    DoEvents
End Sub
Function traitement(ByVal tmp As Integer, ByRef D As Integer)
    Dim tmp2%
    Sheets(1).Select
    Sheets(1).Activate
    D = D + 29
    Sheets(tmp).Select
    Sheets(tmp).Activate
    Range(Cells(1, 1), Cells(25, 6)).Select
    Selection.Copy
    Sheets(1).Select
    Sheets(1).Activate
    Range(Cells(D, 1), Cells(D + 25, 6)).Select
    ActiveSheet.Paste
End Function
Function format(ByVal tmp As Integer)
    Sheets(tmp).Select
    Sheets(tmp).Activate
    Rows("5:5").Select
    Selection.Delete Shift:=xlUp
    Call increm
End Function
Function increm()
    Dim tmp%
    tmp = 5
    While tmp <= 25
            Call chifr(tmp, 1)
        tmp = tmp + 1
    Wend
    tmp = 5
    While tmp <= 25
        Call chifr(tmp, 3)
        tmp = tmp + 1
    Wend
End Function
Function chifr(ByVal lign As Integer, ByVal col As Integer)
    If col = 3 Then
        If Not (lign = 6 Or lign = 8 Or lign = 15 Or lign = 16 Or lign = 20 Or lign = 21 Or lign = 24) Then Exit Function
    End If
    Dim tmp%, chain$
    chain = Cells(lign, col).Value
    If Left(chain, 1) = " " And lign > 4 Then chain = Right(chain, Len(chain) - 1)
    If IsNumeric(Left(chain, 1)) = True And IsNumeric(Mid(chain, 2, 1)) = True And lign > 4 Then
        tmp = Module1.trans(Left(chain, 2))
        chain = Right(chain, Len(chain) - 2)
        chain = " " & tmp & chain
    ElseIf IsNumeric(Left(chain, 1)) = True Then
        tmp = Module1.trans(Left(chain, 1))
        chain = Right(chain, Len(chain) - 1)
        chain = " " & tmp & chain
    End If
    Cells(lign, col).Value = chain
End Function
Function trans(ByVal tmp As Integer) As Integer
    If tmp = 8 Then trans = 6
    If tmp = 9 Then trans = 7
    If tmp = 11 Then trans = 9
    If tmp = 12 Then trans = 10
    If tmp = 14 Then trans = 12
    If tmp = 15 Then trans = 13
    If tmp = 16 Then trans = 14
    If tmp = 17 Then trans = 15
    If tmp = 18 Then trans = 16
    If tmp = 19 Then trans = 17
    If tmp = 20 Then trans = 18
    If tmp = 22 Then trans = 20
    If tmp = 24 Then trans = 22
    If tmp = 25 Then trans = 23
    If tmp = 26 Then trans = 24
    If tmp = 27 Then trans = 25
    If tmp = 29 Then trans = 27
    If tmp = 31 Then trans = 29
    If tmp = 33 Then trans = 31
    If tmp = 35 Then trans = 33
    If tmp = 10 Then trans = 8
    If tmp = 13 Then trans = 11
    If tmp = 21 Then trans = 19
    If tmp = 23 Then trans = 21
    If tmp = 28 Then trans = 26
    If tmp = 30 Then trans = 28
    If tmp = 34 Then trans = 32
End Function
Function img()
    Sheets(1).Select
    Sheets(1).Activate
    Rows("1:26").Select
    Rows("1:26").EntireRow.AutoFit
    Sheets(1).DrawingObjects.Delete
End Function
'Function Selection()
'    Sheets(1).Select
'    Sheets(1).Activate
'    Dim D As Long
'    D = Range("B1048576").End(xlUp).Row
'    Range(Cells(1, 1), Cells(D, 4)).Select
'    Selection.Activate
'    Selection.Copy
'End Function
Public Function Selection()
    Dim D As Long
    With ActiveWorkbook.Worksheets(1)
        D = .Range("B1048576").End(xlUp).Row
        ' ou = .Cells(Rows.Count, 2).End(xlUp).Row
       .Range(.Cells(1, 1), .Cells(D, 4)).Copy
    End With
End Function

Et bien sur s'il y a des chose qui choque ou s'il y a moyen de mieux faire (plus vite ou plus optimisé en écriture), je prend tout les conseil.

bonjour,

ta fonction trans pourrait s'écrire simplement

Function trans(ByVal tmp As Integer) As Integer
if tmp >7 and tmp <36 then trans=tmp-2
end function

pour ton bug, il faudra joindre le fichier.

Je n'avais même pas remarqué merci, et concernant la dernière ligne l'erreur provenais du fait que j'ai corrompus mon fichier à force de le lancer.

Problème résolu, merci car j'ai refait le test avec un long et cela fonctionne.

Cela fonctionne aussi avec un int.

Merci