Faire un copier coller avec vba de cellules non adjacentes

Bonjour,

Je suis un petit nouveau et très honnêtement, un vrai débutant.

J'ai réussi à créer une pseudo macro arrivant à copier des plages de cellules espacées d'une cellule à chaque fois (en partant de la cellule active).

Seulement, en voulant coller dans une feuille à la structure identique, je ne peux pas coller avec le même décalage.
Cela recopie en mettant la sélection de bout en bout sans espaces.

Je vais mieux m'expliquer
supposons que j'ai sélectionné les cellules C4:C5 / C6:C7 Lors de la recopie dans la feuille voulue, il colle mes données sur 4 colonnes adjacentes!!!!

Comment résoudre mon problème, si cela est possible?

Cordialement

Salut,
Je ne comprends pas bien ce que tu veux dire par sélectionner C4:C5/C6:C7 comme si tu sélectionnais en 2 fois alors que ce sont 4 cellules qui se suivent ?
Ce serait bien de voir le code de la macro pour voir où est l'erreur ;)

Pardon, je voulais dire C4:C5 et C7:C8

Bon, je pense avoir compris que tu veux copier des plages de cellules non contigües et les coller à l'identique sur une autre feuille.
Donc, tu sélectionnes les cellules à copier (peu importe le nombre et la taille des plages) et ensuite tu lances la macro. N'oublie pas de remplacer NomFeuilleDestination par le nom de ta feuille.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

Sub CopierPlages() Dim sourceRange As Range Dim destinationRange As Range Dim cell As Range   ' Définir la plage source à copier Set sourceRange = Selection   ' Définir la feuille de destination Dim destinationSheet As Worksheet Set destinationSheet = ThisWorkbook.Sheets("NomFeuilleDestination")   ' Parcourir chaque cellule de la plage source For Each cell In sourceRange ' Copier la cellule actuelle cell.Copy   ' Définir la plage de destination correspondante Set destinationRange = destinationSheet.Range(cell.Address)   ' Coller la cellule dans la plage de destination correspondante destinationRange.PasteSpecial Next cell   ' Effacer le presse-papiers Application.CutCopyMode = False End Sub

---

J'ai intégré vos codes et cela ne fonctionne pas.

Il indique End Sub manquant (entre "Resultat = ActiveCell.Value) et début de vos codes.

J'indique que je suis vraiment nul. Cela fait à peine 1 semaine que j'ai découvert le VBA.

Sub Auto_Open()
'
' FDF_Centres_Validation Macro
'

'

ChDir "C:\XXXXXXX"

Workbooks.Open Filename:="Candidatures.xlsx"

Workbooks.Open Filename:="Composition XXXXX.xlsx"

ActiveSheet.Unprotect Password:="FDF"

Sheets(Array("S_01", "S_02", "S_03", "S_03 BIS", "S_04", "S_04 BIS", "S_05", "S_05 BIS", "S_06", "S_06 BIS", "S_07", "S_07 BIS", "S_08", "S_08 BIS", "S_09", "S_09 BIS", "S_10", "S_10 BIS", "S_11", "S_11 BIS", "S_12", "S_12 BIS", "S_13", "S_13 BIS", "S_14", "S_14 BIS", "S_15", "S_15 BIS", "SEMAINES RETENUES")).Select

ActiveWindow.SelectedSheets.Visible = False

Sheets("Candidatures").Activate

Application.Calculation = xlCalculationManual

Range("Y2:Z300, AB2:AC300, AE2:AF300, AH2:AI300, AK2:AL300, AN2:AO300, AQ2:AR300, AT2:AU300, AW2:AX300, AZ2:BA300, BC2:BD300, BF2:BG300, BI2:BJ300, BL2:BM300, BO2:BP300").Select

Selection.ClearContents

ChDir "C:\XXXXXXX\3-Groupement (Retour_Validation)"

Dim Fichier As String

Fichier = Dir("CENTRE.xlsx")

If Fichier <> "" Then

Workbooks.Open Filename:="CENTRE.xlsx", UpdateLinks:=0
ActiveSheet.Unprotect Password:="FDF"

Dim CENTRE As Range
For Each CENTREIn Range("I2:I" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
CENTRE.Select

Resultat = ActiveCell.Value

Sub CopierPlages()
Dim sourceRange As Range
Dim destinationRange As Range
Dim cell As Range

' Définir la plage source à copier
Set sourceRange = Application.Union(Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, 17)), Range(ActiveCell.Offset(0, 19), ActiveCell.Offset(0, 20)), Range(ActiveCell.Offset(0, 22), ActiveCell.Offset(0, 23)), Range(ActiveCell.Offset(0, 25), ActiveCell.Offset(0, 26)), Range(ActiveCell.Offset(0, 28), ActiveCell.Offset(0, 29)), Range(ActiveCell.Offset(0, 31), ActiveCell.Offset(0, 32)), Range(ActiveCell.Offset(0, 34), ActiveCell.Offset(0, 35)), Range(ActiveCell.Offset(0, 37), ActiveCell.Offset(0, 38)), Range(ActiveCell.Offset(0, 40), ActiveCell.Offset(0, 41)), Range(ActiveCell.Offset(0, 43), ActiveCell.Offset(0, 44)), Range(ActiveCell.Offset(0, 46), ActiveCell.Offset(0, 47)), Range(ActiveCell.Offset(0, 49), ActiveCell.Offset(0, 50)), Range(ActiveCell.Offset(0, 52), ActiveCell.Offset(0, 53)), Range(ActiveCell.Offset(0, 55), ActiveCell.Offset(0, 56)), Range(ActiveCell.Offset(0, 58), ActiveCell.Offset(0, 59)))

' Définir la feuille de destination
Dim destinationSheet As Worksheet
Set destinationSheet = ThisWorkbook.Sheets("Composition XXXXX.xlsx")

' Parcourir chaque cellule de la plage source
For Each cell In sourceRange
' Copier la cellule actuelle
cell.Copy

' Définir la plage de destination correspondante
Set destinationRange = destinationSheet.Range(cell.Address)

' Coller la cellule dans la plage de destination correspondante
destinationRange.PasteSpecial
Next cell

' Effacer le presse-papiers
Application.CutCopyMode = False
End Sub

End

Workbooks("CENTRE.XLSX").Activate

Next CENTRE

Workbooks("CENTRE.XLSX").Close SaveChanges:=False

Else

End If





Merci d'avance de prendre du temps pour moi.

Cordialement

Bonjour
la demande n'est pas claire
veux tu copier des cellules de la colonne A ou bien toute la ligne??
en tt cas revenir avec plus de détail sur les données de départ pour espérer une réponse répond à tes besoins
mais s'il s'agit d'une grande base de données tu peux simplement filter puis copier toute la plage visible
si tu veux parcourir les cellules de la colonne A de la feuilleA et si la cellule n'est pas vide tu la copie en colonne A de la feuille B tu peux faire avec

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub test()   Dim F1 As Worksheet Dim F2 As Worksheet Set F1 = Sheets("Feuil1") Set F2 = Sheets("Feuil2")   ' nétoyer feuille 2 F2.Cells.ClearContents 'copier Dim derlig As Long derlig = F1.Range("A" & Rows.Count).End(xlUp).Row Dim i As Long Tablo = Sheets("feuil1").Range("A2", "A" & Sheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row) L = 2 For i = 2 To derlig If F1.Cells(i, "A") <> "" Then F2.Cells(L, "A") = F1.Cells(i, "A") End If If F2.Cells(L, "A") <> "" Then L = L + 1 Next i F2.Select End Sub

---

ci joint un exemple

Je ne veux copier, ni une colonne entière, ni une ligne entière.

Je vais un peu expliquer le fonctionnement de mes 2 fichiers.

Les 2 fichiers sont identiques, sauf que le 1er, est un filtre avec protection par mot de passe pour éviter d'enlever le filtre.
En gros, on envoie 50 fichiers identiques mais avec des filtres correspondant aux différents centres de secours.
Les responsables du centre doivent retourner le document avec les validations avec OUI ou NON pour les semaines en question.

Exemple : Mr XXXX semaine 01, réponse OUI(Réponse du chef de centre) en I5, réponse NON(réponse du Chef de Groupement) en I6
semaine 02, réponse OUI(Réponse du chef de centre) en I8, réponse OUI(réponse du Chef de Groupement) en I9

etc......

j'ai 15 semaines comme cela.

Je précises que comme il s'agit d'un filtre, j'ai pas de ligne fixe en adressage, mais à partir d'une cellule active. Ce qui est fixe, c'est le nombre d'écart de colonne entre la cellule active et la 1ère cellule de réponse du Chef de Centre (1ère semaine).


Je dois copier toutes ces informations sur un 2ème fichier (le même en structure) mais sans filtre (avec tous les centres).

Vous pourriez dire..........pourquoi ne pas prendre la ligne entière et non des paquets de cellules de 2, espacés par 1 colonne.
Tous simplement, parce que les colonnes qui sont entre les cellules selectionnées, comportent des formules de calcul qui peuvent fluctuer et donc n'etre pas toujours les memes. Il faut donc pas que je les copie.

Je suis pas sur d'être très explicite.





Exemple

C'est normal que ça ne fonctionne pas, on dirait que tu as pris ma macro et que tu l'as insérée quelque part dans une autre macro. On voit bien le début de ta Sub Auto_Open mais pas le end sub qui la termine.
La macro que je t'ai fournie doit être copiée telle quelle dans un module, ensuite tu sélectionnes les cellules à copier et puis tu éxécutes la macro. Tu dois juste changer le nom de la feuille cible dans la macro, là où il est indiqué "NomFeuilleDestination".
Cette macro copie toutes les cellules ou plages de cellules, peu importe le nombre de lignes ou colonnes qui les séparent et les recopie à l'identique sur ta feuille destination. Si ce n'est pas ce que tu veux, alors je n'ai rien compris.

Ok, je commence à comprendre.

J'ai copié votre macro dans un module.

Par contre, je sais pas comment la déclencher...............

Je l'ai dis, ça fait que 1 semaine que j'ai découvert vba et j'avoue avoir des difficultés à comprendre l'articulation VBA.

Cordialement

Bonjour, il faut cliquer sur l'onglet développeur et à gauche du ruban cliquer sur macros, ensuite sélectionner la macro et cliquer sur exécuter.
Je vois que vous démarrez à zéro, avant de vouloir créer vos propres macros, je vous suggère d'apprendre les bases, sinon vous allez passer beaucoup de temps à demander de l'aide.
Ici sur le site, il y a plein de tutoriels qui vous aideront quel que soit votre niveau https://excel.developpez.com/cours/

Bonjour,
Ne serait-ce pas plus judicieux d'utiliser Power Query ?

Merci pour les réponses.

vous inquiétez pas, j'ai pas l'intention de vous poser des questions à tout va.

Pour la réponse, désolé, je me suis mal exprimé.

Oui, bien sur que je sais lancé une macro (au moins ça).

Je voulais dire, comment à partir de 2 modules ou figurent du code, faire interagir les 2 pour obtenir le résultat demander.

Dans le début de ma macro, j'avais mis un Sub Auto_open() avec l'ouverture des fichiers voulus, le positionnement sur les cellules adécoites......sauf que pour faire un copier coller, on me dit qu'il faut prendre la macro de Franc et la mettre dans un autre module.
Ma question est comment faire fonctionner les macros pour que
Juste en cliquant sur la macro, elle se lance, ouvre les fichiers voulus (fichiers origines et fichiers destinataires) afin de copier coller les données dans l'un et l'autre des fichiers, puis tous fermer.

Merci de votre sollicitude.

Dans ta macro Sub Auto_Open() tu appelles ma macro avec Call CopierPlages après la sélection des cellules source, comme ça la macro fera la copie des cellules sélectionnées.
J'avais écrit ma macro en supposant que les cellules sélectionnées se trouvaient sur la feuille active.
Si ce n'est pas le cas, dans ma macro CopierPlages tu devras modifier la source comme ceci:

Code:

---

1 2 3 4 5 6 7 8

Dim wb As Workbook Dim ws As Worksheet Dim sourceRange As Range   Set wb = Workbooks("nom_du_classeur.xlsx") 'remplacez "nom_du_classeur.xlsx" par le nom de votre propre classeur Set ws = wb.Sheets("Feuil1") 'remplacez "Feuil1" par le nom de votre propre feuille   Set sourceRange = ws.Selection 'définit la plage de cellules sélectionnée pour copie

---

et faire de même pour la destination.

j'ai mis le rappel de la macro avec Call et effectivement, cela fonctionne.

Par contre, j'ai un message

erreur d'exécution '9':
L'indice n'appartient pas à la sélection.

Sub CopierPlages()
Dim sourceRange As Range
Dim destinationRange As Range
Dim cell As Range


' Définir la plage source à copier
Set sourceRange = Application.Union(Range(ActiveCell.Offset(0, 16), ActiveCell.Offset(0, 17)), Range(ActiveCell.Offset(0, 19), ActiveCell.Offset(0, 20)), Range(ActiveCell.Offset(0, 22), ActiveCell.Offset(0, 23)), Range(ActiveCell.Offset(0, 25), ActiveCell.Offset(0, 26)), Range(ActiveCell.Offset(0, 28), ActiveCell.Offset(0, 29)), Range(ActiveCell.Offset(0, 31), ActiveCell.Offset(0, 32)), Range(ActiveCell.Offset(0, 34), ActiveCell.Offset(0, 35)), Range(ActiveCell.Offset(0, 37), ActiveCell.Offset(0, 38)), Range(ActiveCell.Offset(0, 40), ActiveCell.Offset(0, 41)), Range(ActiveCell.Offset(0, 43), ActiveCell.Offset(0, 44)), Range(ActiveCell.Offset(0, 46), ActiveCell.Offset(0, 47)), Range(ActiveCell.Offset(0, 49), ActiveCell.Offset(0, 50)), Range(ActiveCell.Offset(0, 52), ActiveCell.Offset(0, 53)), Range(ActiveCell.Offset(0, 55), ActiveCell.Offset(0, 56)), Range(ActiveCell.Offset(0, 58), ActiveCell.Offset(0, 59)))


' Définir la feuille de destination
Dim destinationSheet As Worksheet
Set destinationSheet = ThisWorkbook.Sheets("Composition GIFF 03.xlsx")


' Parcourir chaque cellule de la plage source
For Each cell In sourceRange
' Copier la cellule actuelle
cell.Copy

' Définir la plage de destination correspondante
Set destinationRange = destinationSheet.Range(cell.Address)

' Coller la cellule dans la plage de destination correspondante
destinationRange.PasteSpecial
Next cell

' Effacer le presse-papiers
Application.CutCopyMode = False
End Sub

Ce serait bien de préciser quelle ligne provoque l'erreur.

Celle-ci :

Set destinationSheet = ThisWorkbook.Sheets("Composition GIFF 03.xlsx")

Bonjour

Effectivement tu essayes de sélectionner une feuille avec ce qui ressemble à un nom de classeur

On devrait avoir

Code:

---

Set destinationSheet = ThisWorkbook.Sheets("NomDeLaFeuille")

---

Composition GIFF 03.xlsx est réellement le nom de lafeuille ?

En passant tu te prépares des réveils douloureux quand tu va faire de la maintenance sur tout ça.

Si j'ai bien compris le sujet, perso ce que je ferais en restant en VBA c'est :
- charger un tableau en analysant une ligne et en retenant les colonnes des cellules déprotégées
- boucler sur les lignes filtrées du classeur source pour savoir quelles lignes copier (plutôt que gérer les offset des bonnes lignes)
- boucler sur le tableau pour copier l'intersection ligne/colonne.

Effectivement, "COMPOSITION GIFF 03.xlsx" est bien un classeur et non une feuille


Et pour ton analyse, oui, c'est bien cela.

Comme je l'ai dis, je bidouilles vraiment.

J'ai réussi à faire un semblant d'automatisation en prenant des bouts de codes d'un peu partout.
J'ai de très bonnes notions Excel et avait de très bonnes connaissances sur l'automatisation avant VBA.

VBA, je connais pas et oui, effectivement, c'est pas facile de décoder du chinois quand tu connais pas la langue.


Cordialement.

Et en attendant, merci de prendre du temps pour m'aider.