Discussion :

[Cartouche03]

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

[Franc]

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

[Cartouche03]

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

[Franc]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Cartouche03]

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

[BENNASR]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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