Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur (VBA)

[prorudess]

Bonjour le forum,
Je cherche à copier toute les cellules déverrouillées d'une feuille vers un autre fichier qui me servira d'historisation.
C'est à dire qu'à chaque fois que je lancerais la macro, seule les cellules déverrouillées se copieront à la prochaine ligne vide de mon classeur.
Je vous laisse un exemple où la feuille 1 représente les cellules à exporter de telle sorte qu'elles apparaissent comme indiqué sur la feuille 2.
En espérant avoir été assez clair dans mes explications.
Merci d'avance.

 

[tototiti2008]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Bonjour produress,

ton classeur exemple est vide

 

[prorudess]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Désolé erreur de manipulation.
C'est corrigé merci !!!

 

[tototiti2008]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Re,

Les cellules déverrouillées peuvent changer de place et la macro doit parcourir les cellules déverrouillées quelles que soient leur position, ou veux-tu simplement reprendre les valeurs de C4, C5 et A11 de façon fixe ?

 

[prorudess]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Non,
Je souhaiterais que la macro puisse parcourir l'ensemble (ou seulement une plage) de la feuille en copiant toutes les cellules déverrouillées dans un autre classeur peu importe la place.

 

[tototiti2008]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Re,


Pour l'instant ça copie dans la feuille classeur, conformément à ton classeur exemple

à tester

Sub test()
Dim PremCell As String, CoursCell As String
Dim Ligne As Long, Col As Long
    Ligne = ThisWorkbook.Sheets("Classeur").Range("A65536").End(xlUp).Row + 1
    Col = 1
    With ThisWorkbook.Sheets("Feuil1")
        If .Range("A1").Locked Then
            PremCell = .Range("A1").Next.Address
        Else
            PremCell = "$A$1"
        End If
        CoursCell = PremCell
        Do
            ThisWorkbook.Sheets("Classeur").Cells(Ligne, Col).Value = .Range(CoursCell).Value
            Col = Col + 1
            CoursCell = .Range(CoursCell).Next.Address
        Loop Until CoursCell = PremCell
    End With
End Sub

 

[prorudess]

Re : Copier toutes les cellules déverrouillées d'une feuille vers un autre classeur

Merci beaucoup,
C'est exactement ce que je cherchais.
Je l'adapte à mon fichier et je reviens vers toi si jamais j'ai d'autres questions.
Merci encore bonne soirée