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
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)
VB:
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
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 ?
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 ?
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
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
VB:
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
Et par rapport aux cellules fusionnées, ceci semble fonctionner
VB:
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
Et par rapport aux cellules fusionnées, ceci semble fonctionner
VB:
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
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 ?
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 ?
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é :
VB:
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
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 :
VB:
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