XL 2019 Copier / Coller

[Tioneb_h]

Bonjour, je voudrais copier toutes les cellules déverrouillées non contiguës d’une feuille de calcul avec un bouton et coller les valeurs des cellules vers une autre feuille de calcul (autre fichier), MAIS à la même place ! Avec : Ctrl V
Quelqu’un peut m’aider ?
Merci d’avance pour votre aide
Ben

 

[Tioneb_h]

Re

Pour t'éviter de te fatiguer, voila de quoi faire le test toi-même sur une feuille vierge d'un classeur vide.
Lances d'abord cette macro: Creer_Test
(elle ne sert qu'à créér un exemple)

Puis lances la macro: Verouiller_Cellules_Vides

Tu verras que les cellules vides seront verrouillées.
NB: J'ai mis en jaune les cellules vides juste pour les trouver facilement
(cela ne sert que pour le test)

Sub Creer_Test()
Dim formule$, rng As Range: Set rng = Range("A1:J30")
formule = "=CHOOSE(RANDBETWEEN(1,5),CHAR(RANDBETWEEN(65,90)),INT(ROW()*NOW()/1600),11,"""",33)"
Application.ScreenUpdating = False
rng.Formula = formule: rng = rng.Value: rng.Locked = 0
End Sub
Sub Verouiller_Cellules_Vides()
Range("A1:J30").SpecialCells(xlCellTypeBlanks).Locked = True
' ligne ci-dessous pour test
Range("A1:J30").SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
End Sub

bonjour,

super... cela fonctionne
Comme est-ce que je peux faire avec également des cellules fusionnées (j'ai les deux) ? en sachant que Excel n'aime pas les fusions de cellules ?

bien à vous,
ben

 

[Tioneb_h]

bonjour,

super... cela fonctionne
Comme est-ce que je peux faire avec également des cellules fusionnées (j'ai les deux) ? en sachant que Excel n'aime pas les fusions de cellules ?

bien à vous,
ben

voici mon code :

Sub Verrouiller_Cellules_Idem_Fusionnées_Vides()

If ActiveWorkbook.ReadOnly = True Then
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
    Range("A1:Q46").SpecialCells(xlCellTypeBlanks).Locked = True
    Else
    Range("A1:Q46").SpecialCells(xlCellTypeBlanks).Locked = True
End If

ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

End Sub

 

[Staple1600]

Bonjour

Y aurait pas comme un problème de logique ?
SI Condition=VRAI alors VRAI sinon VRAI
Ce serait pas plutôt
SI Condition=VRAI alors VRAI sinon FAUX

Sub Verrouiller_Cellules_Idem_Fusionnées_Vides()

If ActiveWorkbook.ReadOnly = True Then
    ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
    Range("A1:Q46").SpecialCells(xlCellTypeBlanks).Locked = True
    Else
    Range("A1:Q46").SpecialCells(xlCellTypeBlanks).Locked = True
End If
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
End Sub

 

[Staple1600]

Re

Et par rapport aux cellules fusionnées, ceci semble fonctionner

Sub Macro_test_ok()
Dim c As Range
For Each c In Range("A1:Q46").SpecialCells(xlCellTypeBlanks)
If c.MergeCells Then
c.MergeArea.Locked = True
Else
c.Locked = True
End If
Next
End Sub

 

[Tioneb_h]

Re

Et par rapport aux cellules fusionnées, ceci semble fonctionner

Sub Macro_test_ok()
Dim c As Range
For Each c In Range("A1:Q46").SpecialCells(xlCellTypeBlanks)
If c.MergeCells Then
c.MergeArea.Locked = True
Else
c.Locked = True
End If
Next
End Sub

ça ne marche pas les cellules fusionnées se verrouillent quand même.

 

[Staple1600]

Re

Tu auras remarqué le nom de ma macro, non ?
Macro_test_ok

Ce qui veut dire
1) que j'ai testé mon code avant de le poster ici
2) qu'il est donc fonctionnel

Par contre, tu peux écrire:
"je n'arrive pas à faire fonctionner ton code sur mon fichier"
Là, oui c'est possible.

 

[Tioneb_h]

Re

Tu auras remarqué le nom de ma macro, non ?
Macro_test_ok

Ce qui veut dire
1) que j'ai testé mon code avant de le poster ici
2) qu'il est donc fonctionnel

Par contre, tu peux écrire:
"je n'arrive pas à faire fonctionner ton code sur mon fichier"
Là, oui c'est possible.

je ne suis pas expert... voici un extrait de mon fichier pour voir.

 

[Staple1600]

Re

J'ai testé sur ton classeur

Sub Macro_test_ok()
Application.ScreenUpdating = False
Dim c As Range
For Each c In Range("C4:Q46").SpecialCells(xlCellTypeBlanks)
If c.MergeCells Then
c.MergeArea.Locked = True
Else
c.Locked = True
End If
Next
End Sub

Les cellules vides fusionnées ou pas voient leur propriété Verrouillée cochées.
(donc Locked=True)
Pour t'en convaincre, clic-droit sur la cellule C17 par exemple
(puis Format de cellule/Protection
La case Verrouillée est cochée, non ?

 

[Tioneb_h]

Re

J'ai testé sur ton classeur

Sub Macro_test_ok()
Application.ScreenUpdating = False
Dim c As Range
For Each c In Range("C4:Q46").SpecialCells(xlCellTypeBlanks)
If c.MergeCells Then
c.MergeArea.Locked = True
Else
c.Locked = True
End If
Next
End Sub

Les cellules vides fusionnées ou pas voient leur propriété Verrouillée cochées.
(donc Locked=True)
Pour t'en convaincre, clic-droit sur la cellule C17 par exemple
(puis Format de cellule/Protection
La case Verrouillée est cochée, non ?

oui, la C17 est bien Verrouillée mais la G17 est également Verrouillée alors qu'elle n'est pas vide ?

 

[Tioneb_h]

Bonjour Benoit, bonjour le forum,

D'abord il faut que tu saches que VBA et les cellules fusionnées ne sont pas amis du tout. D'autant plus que la conception de tes fichiers ne nécessitait pas de cellules fusionnées. À l'avenir pense VBA => pas de cellules fusionnées... Pense aussi que si tu avais joint les fichiers dès ton premier post on n'aurait pas perdu de temps...
Tu as placé le code dans les deux fichiers !... Est-ce vraiment nécessaire ? Normalement il aurait dû être placé uniquement dans le fichier source et pas dans un composant Worksheet comme Feuil1 (METRE), mais dans un module standard comme Module1. Mais ça, ce n'était pas ce qui causait le bug.
Le code modifié :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As FileDialog 'déclare la variable F (Fichier)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CEL As Range 'déclare la variable CEL (CELlule)

Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.Worksheets("METRE") 'définit l'onglet source OS
Set F = Application.FileDialog(msoFileDialogOpen) 'définit le fichier F (à l'aide de la boîte de dialogue [Ouvrir])
F.Show 'affiche la boîte de dialogue
If F.SelectedItems.Count > 0 Then 'condition si au moins un fichier est sélectionné
    Workbooks.Open (F.SelectedItems(1)) 'ouvre le fichier sélectionné
Else 'sinon
    Exit Sub 'sort de la procédure
End If
Set CD = ActiveWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("METRE") 'définit l'onglet destination OD
For Each CEL In OS.UsedRange 'boucle sur toutes les cellules CEL de la plage éditée de l'onglet OS
    'si la cellule est déverrouillée, copy la cellule dans l'onglet OD à la même adresse
    If CEL.Locked = False Then CEL.MergeArea.Copy OD.Range(CEL.MergeArea.Address)
Next CEL 'prochaine celllue de la boucle
End Sub

Le fichier source :

Bonjour Robert,

J'ai modifié le code pour faire un copier/coller sur trois feuilles...
Maintenant il me fait un copier/coller avec un lien du fichier source ?! et plus un vrai copier/coller ;-(

Pouvez-vous m'aider
voici le code :

Private Sub CommandButton5_Click()

Dim CS As Workbook 'déclare la variable CS (Classeur source)

Dim OSM As Worksheet 'déclare la variable OSM (Onglet Source METRE)
Dim OSP As Worksheet 'déclare la variable OSP (Onglet Source PRIX DE VENTE)
Dim OSH As Worksheet 'déclare la variable OSH (Onglet Source HONORAIRES)

Dim F As FileDialog 'déclare la variable F (Fichier)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)

Dim ODM As Worksheet 'déclare la variable ODM (Onglet Destination METRE)
Dim ODP As Worksheet 'déclare la variable ODP (Onglet Destination PRIX DE VENTE)
Dim ODH As Worksheet 'déclare la variable ODH (Onglet Destination HONORAIRES)

Dim cel As Range 'déclare la variable CEL (CELlule)
Set CS = ThisWorkbook 'définit la classeur source CS

Set OSM = CS.Worksheets("METRE") 'définit l'onglet source OSM
Set OSP = CS.Worksheets("PRIX DE VENTE") 'définit l'onglet source OSP
Set OSH = CS.Worksheets("HONORAIRES") 'définit l'onglet source OSH

Set F = Application.FileDialog(msoFileDialogOpen) 'définit le fichier F (à l'aide de la boîte de dialogue [Ouvrir])
F.Show 'affiche la boîte de dialogue
If F.SelectedItems.Count > 0 Then 'condition si au moins un fichier est sélectionné
    Workbooks.Open (F.SelectedItems(1)) 'ouvre le fichier sélectionné
Else 'sinon
    Exit Sub 'sort de la procédure
End If
Set CD = ActiveWorkbook 'définit le classeur destination CD

Set ODM = CD.Worksheets("METRE") 'définit l'onglet destination ODM
For Each cel In OSM.UsedRange 'boucle sur toutes les cellules CEL de la plage éditée de l'onglet OSM
    'si la cellule est déverrouillée, copy la cellule dans l'onglet ODM à la même adresse
    If cel.Locked = False Then cel.MergeArea.Copy ODM.Range(cel.MergeArea.Address)
Next cel 'prochaine celllue de la boucle

Set ODP = CD.Worksheets("PRIX DE VENTE") 'définit l'onglet destination ODP
For Each cel In OSP.UsedRange 'boucle sur toutes les cellules CEL de la plage éditée de l'onglet OSP
    'si la cellule est déverrouillée, copy la cellule dans l'onglet ODP à la même adresse
    If cel.Locked = False Then cel.MergeArea.Copy ODP.Range(cel.MergeArea.Address)
Next cel 'prochaine celllue de la boucle

Set ODH = CD.Worksheets("HONORAIRES") 'définit l'onglet destination ODH
For Each cel In OSH.UsedRange 'boucle sur toutes les cellules CEL de la plage éditée de l'onglet OSH
    'si la cellule est déverrouillée, copy la cellule dans l'onglet ODH à la même adresse
    If cel.Locked = False Then cel.MergeArea.Copy ODH.Range(cel.MergeArea.Address)
Next cel 'prochaine celllue de la boucle

End Sub

Benoît