Copier/Coller Récalcitrant

Bonjour le forum,

Je suis sur une partie du code où j'effectue un test pour savoir s'il y a trop d'éléments sur la feuille, auquel cas, il faut créer une seconde feuille avec la même appellation en rajoutant un signe distinctif, par exemple (2).

Jusque là ça fonctionne correctement.

Je veux ensuite copier l'éxcedant pour le mettre sur la nouvelle feuille, mais ne connaissant pas la taille du tableau à l'avance j'ai essayé ce code :

WbC = ThisWorkbook.Name
lastCol = Cells(4, Columns.Count).End(xlToLeft).Column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
If lastCol > 18 Then
mySheet = ActiveSheet.Name & "(2)"
Workbooks(WbC).Sheets.Add.Name = mySheet
Sheets("Feuil1").Range(Cells(4, 19), Cells(lastRow, lastCol)).Copy Sheets("mySheet").Range("E4")

Et la dernière ligne bug (erreur 9, l'indice n'appartient pas à la sélection).

J'ai essayé de diverses manière mais cela n'a pas l'air de changer.

C'est surement un truc tout con mais là je bloque.

Donc voilà, si quelqu'un me file un coup de main, cela sera très apprécié.

5bcpelements3.xlsm (25.46 Ko)

Salut,

Essaie de passer par l'intermédiaire d'une adresse

Dim lastCol As Integer
Dim lastRow As Integer
Dim mySheet As String

Sub Macro1()

lastCol = Cells(4, Columns.Count).End(xlToLeft).Column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

Set cellule_1 = Worksheets("Feuil1").Cells(lastRow, lastCol)

If lastCol > 18 Then
    mySheet = ActiveSheet.Name
    ThisWorkbook.Sheets.Add.Name = mySheet & "_2"
    Sheets("Feuil1").Range("S4:" & cellule_1.Address).Copy ActiveSheet.Range("E4")
End If

End Sub

Cordialement.

7bcpelements3.xlsm (29.41 Ko)

Salut Yvouille

Excel fait un peu n'importe quoi aujourd'hui, des fois il marche, des fois non, sans raison apparente, mais sinon ça fonctionne,

Merci du coup de main.

Rechercher des sujets similaires à "copier coller recalcitrant"