XL 2019 Copier / Coller

Tioneb_h

XLDnaute Nouveau
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
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir Tioneb, bonsoir le forum,

Peut_être comme ça (à adapter) :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CEL As Range 'déclare la variable CEL (CELlule)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD (à adapter à ton cas)
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.Copy OD.Range(CEL.Address)
Next CEL 'prochaine celllue de la boucle
End Sub
 

patricktoulon

XLDnaute Barbatruc
Bonjour
si c'est seulement les valeurs qui sont souhaitées
pas besoins de copier
on compile la plage avec union
puis feuil2 meme address=la plage

VB:
Sub test()
    Dim p As Range, p2 As Range
    Set p = Feuil1.UsedRange

    For Each cel In p.Cells
        If cel.Locked = False Then If p2 Is Nothing Then Set p2 = cel Else Set p2 = Union(p2, cel)
    Next
    Feuil2.Range(p2.Address) = p2
End Sub
 

Tioneb_h

XLDnaute Nouveau
Bonsoir Tioneb, bonsoir le forum,

Peut_être comme ça (à adapter) :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CEL As Range 'déclare la variable CEL (CELlule)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD (à adapter à ton cas)
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.Copy OD.Range(CEL.Address)
Next CEL 'prochaine celllue de la boucle
End Sub
bonjour,

Je viens de faire le test... et ça fonctionne sur le même classeur 👍

Comment est-ce que l'on peut faire pour avoir la même chose d'un classeur1 ("Feuil1") à une autre calsseur2 ("Feuil1") ?

les noms des classeurs ne sont pas fixes...
exemples :
22-01-12 Calcul devis XXX_TSC.xlsm
22-02-09 Calcul devis XXX_BHE.xlsm

Ben
 

patricktoulon

XLDnaute Barbatruc
Bonjour
Je ne suis pas sur que copy destination fonctionne sur deux classeurs( je peux me tromper)
tester alors copy puis selection classeur 2,feuille destination , range de destination puis paste et paste specialformat si l'on veux garder les formats
si le format n'est pas une donnée de l’équation alors un simple value=value fait l'affaire
exemple
workbooks("classeur2.xlsm").feuil1.range("A1:F10").value=thisworkbook.feuil1.range("C3:H13").value
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir le fil, bonsoir le forum,

Essaie comme ça. Code à mettre dans le classeur source :

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("Feuil1") '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("Feuil1") '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.Copy OD.Range(CEL.Address)
Next CEL 'prochaine celllue de la boucle
End Sub
 

Tioneb_h

XLDnaute Nouveau
Bonsoir le fil, bonsoir le forum,

Essaie comme ça. Code à mettre dans le classeur source :

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("Feuil1") '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("Feuil1") '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.Copy OD.Range(CEL.Address)
Next CEL 'prochaine celllue de la boucle
End Sub
Bonjour,

Encore merci pour votre retour rapide :)
J'ai une erreur 400 ?
Je vous ai joint les deux fichiers pour exemple... copier le classeur1 dans le classeur 2.

encore merci,
Ben
 

Pièces jointes

  • Classeur1.xlsm
    21 KB · Affichages: 3
  • Classeur2.xlsm
    20.9 KB · Affichages: 8

Tioneb_h

XLDnaute Nouveau
bonjour,

j'ai trouvé pourquoi j'ai une erreur 400... c'est parce que j'ai des cellules fusionnées !

est-ce qu'il y a moyen de changer le code pour copier/coller des cellules fusionnées vers d'autres cellules fusionnées de l'autre fichier ?

j'espère que votre savoir faire va pouvoir m'aider :)

Ben
 

Robert

XLDnaute Barbatruc
Repose en paix
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é :

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

Le fichier source :
 

Pièces jointes

  • Benoit_ED_v01.xlsm
    22.3 KB · Affichages: 2

Tioneb_h

XLDnaute Nouveau
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é :

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

Le fichier source :
Bonjour,
Désolé pour les allers/retours... tout fonctionne.
Merci pour votre savoir-faire.
Ben
 

Tioneb_h

XLDnaute Nouveau
Bonjour,

Je suis super contant pour la Macro... ça fonctionne super bien 👍et me fait gagner beaucoup de temps dans mes transferts de calcul.

J'ai encore une idée pour aller plus vite dans le copier/coller d'un fichier à l'autre... (si possible) : est-ce que la VBA peut "verrouiller" toutes les cellules vides qui sont "déverrouillées" avant de faire le copier/coller ? ça limiterait le nombre de cellules à checker ?

Pour info, j'ai au total dans mon ficher 5340 cellules déverrouillées...

Merci d’avance pour votre aide,
Ben
 

Staple1600

XLDnaute Barbatruc
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)
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
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
362

Statistiques des forums

Discussions
311 725
Messages
2 081 939
Membres
101 844
dernier inscrit
pktla