Déprotéger les feuilles, repartir les données et reprotéger les feuilles

Question

Bonjour à la communauté. j'y suis encore avec mes difficultés

Difficulté 1 (les feuilles concernée sont ‘’BD, Rep1 et Rep2’’)

Dans mon classer, il y’a plusieurs feuilles. La 1^re feuille (base de données) contient la liste de plusieurs produits, leur date d’arrivée et leur numéro étiquette. En exécutant le code, la répartition est bien faite. (Problème résolu)

Après répartition, je voudrais que les feuilles dans lesquelles sont reparties les noms des produits (ici ReP1, Rep2) soient protégées par un mot de passe ‘’1234’’ (Problème non résolu)

NB : J’ai voulu adapter un code que M. Dan a proposé (qui marche pour la répartition). Mais je n’y parviens pas puisqu’à la fin je me retrouve avec les données bien reparties dans les feuilles, mais seule la feuille active au moment de l’exécution du code est protégée. Les autres ne sont pas protégées.

Difficulté2. ( les feuilles concernée sont ‘’Z1, Z2, vérificateur’’)

Elle concerne la copie de certaines données et cela se complique plus pour moi car il s’agit des données à extraire d’un tableau extensible.

Je voudrais

Copier l’ensemble des données de la feuille Z1 partant de ‘’G4’’ et s’arrêtant à la dernière ligne de ‘’I’’ que je vais coller sur la feuille (‘’vérificateur’’) à partir de la cellule B4
Copier l’ensemble des données de la feuille Z1 partant de ‘’K4’’ et s’arrêtant à la dernière ligne de ‘’N’’ que je vais coller sur la feuille (‘’vérificateur’’) à partir de la cellule E4

Copier l’ensemble des données de la feuille Z1 partant de ‘’O4’’ et s’arrêtant à la dernière ligne de ‘’Q’’ que je vais coller sur la feuille (‘’vérificateur’’) à partir de la cellule H

merci bien pour vos aides.

9exceldalod-copie.xlsm (50.61 Ko)

Dan · Accepted Answer

Dans le code, en dessous de cette ligne --&gt; feuille = cel.Offset(0, 4).Value, remplacez la ligne Activesheet.unprotect par ceci Sheets(feuille).Unprotect "1234" Ensuite à la fin du code, avant la ligne Msgbox remplacez la ligne Activesheet.protect par Sheets("Rep1").Protect "1234" Sheets("Rep2").Protect "1234"...

Dan · Accepted Answer

Re Essayez ce code Sub test() Dim lig As Integer Dim i As Byte, j As Byte, k As Byte Dim feuille, tablo() Application.ScreenUpdating = False feuille = Array("Z1", "Z2") With Sheets("Vérificateur").ListObjects(1) On Error Resume Next .DataBodyRange.Delete 'effacer tableau si existant On Error GoTo 0 For k = 0 To UBound(feuille) If .ListRows.Count = 0 Then .ListRows.Add: lig = 1 Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne End If For i = 1 To 3 With Sheets(feuille(k)).ListObjects(1) tablo = Union(.ListColumns(j + i + 4).DataBodyRange, .ListColumns(j + i + 5).DataBodyRange, .ListColumns(j + i + 6).DataBodyRange) End With With .DataBodyRange .Item(lig, j + 1).Resize(UBound(tablo), UBound(tablo) - 1) = tablo End With Select Case i Case 1: j = 3 Case 2: j = 6 Case 3: j = 0 End Select Next i Next k End With Application.ScreenUpdating = False End Sub Faites un test Si ok --&gt; Cordialement Edit : Modifié code...

Dan · Answer

J'ai fait votre code par rapport à votre demande où vous mentionniez les feuilles Z1 et Z2 S'il s'agit d'exporter dans la feuille vérification un choix que vous faites dans une combo ( ce que je comprends au vu de votre réponse et que vous auriez dû préciser au départ), c'est différent évidemment. On n'a pas besoin de boucler sur la variable k. Il y a donc plusieurs lignes à modifier Dites moi Cordialement...

Dan · Answer

Ok. Deux questions :
- Que contient la combo --> le nom des feuilles Z1, Z2 ?
- Est-ce vous devez cliquez sur un bouton pour exporter ou cela doit se faire dès que le choix est fait dans la combo ?

Dan · Answer

Remplacez le code Combobox1_change par celui ci-dessous :

Private Sub Combobox1_change()
Dim lig As Integer
Dim i As Byte, j As Byte
Dim tablo()

If combobox1.ListIndex = -1 Then Exit Sub

Application.ScreenUpdating = False

With Sheets("Vérificateur").ListObjects(1)
    On Error Resume Next
    .DataBodyRange.Delete 'effacer tableau si existant
    On Error GoTo 0

    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    Else: .ListRows.Add: lig = .ListRows.Count
    End If

    For i = 1 To 3
        With Sheets(combobox1.Value).ListObjects(1)
            tablo = Union(.ListColumns(j + i + 4).DataBodyRange, .ListColumns(j + i + 5).DataBodyRange, .ListColumns(j + i + 6).DataBodyRange)
        End With

        .DataBodyRange.Item(lig, j + 1).Resize(UBound(tablo), UBound(tablo) - 1) = tablo

        Select Case i
            Case 1: j = 3
            Case 2: j = 6
            Case 3: j = 0
        End Select
    Next i

End With
Application.ScreenUpdating = False
End Sub

Cela suppose que la combo n'est utilisée que pour faire cette opération d'export.

Faites un test