Porblème de boucle

Bonsoir,

J'ai un petit soucis svp

Le fichier joint possède une boucle pour automatiser la copie de lignes d'une feuille vers une autre selon l’intitulé de la feuille cible en B2, B3, B4, Ca fonctionne très bien quand j'y vais pas à pas avec f8 dans la console vba mais depuis le bouton de lancement c'est le carnage, il exécute les deux première ligne mais se plante sur la dernière et me la copie dans la fiche de départ et non la cible. J'ai eu aussi une autre erreur qui revient de temps en temps , ""L'indice n'appartient à la sélection"

Le fichier est joint et voici svp le code source en question :

J'ai laissé le code sans boucle en commentaire pour avoir la version sans boucle sous la main.

Sub Rectangle1_Cliquer()

Dim boucle1 As Integer
Derligne = 2

           'With Sheets(Range("B2").Value)

            '.Rows(Derligne).Insert

            'Range("A2,C2:F2").Copy
            '.Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues

        'End With

For boucle1 = 2 To 4
        With Sheets(Range("B" & boucle1).Value)

            .Rows(Derligne).Insert

            Range("A" & boucle1 & "," & "C" & boucle1 & ":F" & boucle1).Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues

        End With
Next boucle1

End Sub

Si vous pouviez lancer le fichier pour voir le bug ca serait sympa et peut être m'éclairer je continue à chercher de mon côté

Merci

Salut variable,

... on ne peut pas dire que tu aies bien choisi ton pseudo...

Courage, ça va aller!

'
Dim wks As Worksheet
Set wks = Worksheets("Tableau")
'
For x = 2 To 4
    sWks = Range("B" & x).Value
    With Worksheets(sWks)
        iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & iRow).Value = wks.Range("A" & x).Value
        .Range("B" & iRow & ":" & "E" & iRow).Value = wks.Range("C" & x & ":" & "F" & x).Value
    End With
Next
'

Ici, je ne vérifie pas l'existence des feuilles ciblées! J'ose croire que tu as eu la clairvoyance de les créer et de respecter la correspondance entre les intitulés (je parle évidemment de ton fichier de travail!)

A+

Bonsoir compatriote,

Mon pseudo indique surtout que mon bien être est très variable et non la variable en programmation ou je me contente de bricoler

Ceci écrit, ton code envoi le miens à la poubelle car il fonctionne parfaitement et je t'en remercie.

Bonne nuit et encore merci

J'ai modifié le code pour que le dernier enregistrement soit le premier en haut c'est important dans la requête de départ.

Encore merci.

....
irow = 2
For x = 2 To 4
    swks = Range("A" & x).Value
    With Worksheets(swks)
        'iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Rows(irow).Insert
.....