Modifier et simplifier un code

Bonjour,

Dans le code ci-joint je souhaiterais:

1) le simplifier moins de lignes

2) insérer une colonne entre chaque colonnes collées

ex; je colle en A et B feuil "2 poules "il faudrait insérer une colonne entre A et B ce qui amènerait le collage en A et C

Merci pour votre aide

Sub CopierColler()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet

    If ThisWorkbook.Sheets("Tournoi").Range("C1").Value = 2 Then
        Set wsSource = ThisWorkbook.Sheets("Tournoi")
        Set wsDestination = ThisWorkbook.Sheets("2poules")
        wsSource.Range("C2:D20").Copy
        wsDestination.Range("A3:B20").PasteSpecial Paste:=xlPasteAll
    End If

    If ThisWorkbook.Sheets("Tournoi").Range("C1").Value = 3 Then
        Set wsSource = ThisWorkbook.Sheets("Tournoi")
        Set wsDestination = ThisWorkbook.Sheets("3poules")
        wsSource.Range("C2:E20").Copy
        wsDestination.Range("A3:C20").PasteSpecial Paste:=xlPasteAll
    End If

    If ThisWorkbook.Sheets("Tournoi").Range("C1").Value = 4 Then
        Set wsSource = ThisWorkbook.Sheets("Tournoi")
        Set wsDestination = ThisWorkbook.Sheets("4poules")
        wsSource.Range("C2:F20").Copy
        wsDestination.Range("A3:D20").PasteSpecial Paste:=xlPasteAll
    End If

    Application.CutCopyMode = False
End Sub

Hello,

Une proposition

Sub CopierColler()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim nbPoules As Integer
    Dim colOffset As Integer

    Set wsSource = ThisWorkbook.Sheets("Tournoi")
    nbPoules = wsSource.Range("C1").Value

    If nbPoules >= 2 And nbPoules <= 4 Then
        Set wsDestination = ThisWorkbook.Sheets(nbPoules & "poules")

        colOffset = (nbPoules - 1) * 2 ' Insère une colonne vide après chaque collage
        wsSource.Range("C2").Resize(19, nbPoules).Copy
        wsDestination.Range("A3").Resize(19, nbPoules * 2 - 1).PasteSpecial Paste:=xlPasteAll
    End If

    Application.CutCopyMode = False
End Sub

Dis moi si c'est ok

@+

Bonjour,

Oupss, un peu à la bourre... Salut Baroute

Un peu sur le même principe...

Sub CopierColler()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim Nb As Byte, I As Byte
Application.ScreenUpdating = False
Set wsSource = ThisWorkbook.Sheets("Tournoi")
Nb = wsSource.Range("C1").Value
If Nb < 2 Or Nb > 4 Then Exit Sub
Set wsDestination = ThisWorkbook.Sheets(Nb & "poules")
wsSource.Range("C2").Resize(19, Nb).Copy wsDestination.Range("A3")
With wsDestination
    For I = Nb To 2 Step -1
        .Columns(I).Insert
    Next I
End With
    Application.CutCopyMode = False
End Sub

Bonne journée

Hey,

Dans ma première proposition c'est cette partie qui permet d'espacer les colonnes : Resize(19, nbPoules * 2 - 1)

Mais ce n'est pas spécialement super lisible.

Une autre proposition plus pragmatique avec le offset pour bien marquer le décalage de colonne ce qui revient à la même chose que notre ami breton que je salue

Sub CopierColler()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim nbPoules As Integer
    Dim colDestination As Range
    Dim i As Integer

    Set wsSource = ThisWorkbook.Sheets("Tournoi")
    nbPoules = wsSource.Range("C1").Value

    If nbPoules >= 2 And nbPoules <= 4 Then
        Set wsDestination = ThisWorkbook.Sheets(nbPoules & "poules")
        Set colDestination = wsDestination.Range("A3") ' Première cellule destination

        For i = 0 To nbPoules - 1
            wsSource.Range("C2").Offset(0, i).Resize(19, 1).Copy
            colDestination.Offset(0, i * 2).PasteSpecial Paste:=xlPasteAll
        Next i
    End If

    Application.CutCopyMode = False
End Sub

@+

Bonjour à tous les 2

Merci pour vos réponses

Exactement ce qu'il me fallait

Cordialement