Exclure certaines colonnes lors de la copie d'une ligne vers une autre

Question

Je souhaite copier le contenu d'une ligne dans Excel vers l'autre ligne.

Actuellement, j'utilise le code suivant pour copier des données de la rangée précédente.

rngCurrent.Offset(-1).Copy 
rngCurrent.PasteSpecial (xlPasteValues) 

mais je souhaite ignorer certaines colonnes. Alors disons s'il y a 20 colonnes, je veux copier toutes les colonnes sauf les colonnes 4 et 14. Comment cela peut-il être réalisé en VBA?

Exemple:

On suppose ci-après les données de la rangée.

Row to be copied........> 1 2 3 4 5 6 7 8 .... 14 15 16 
Target Row Before Copy..> A B C D E F G H .... N O P 
Target Row After Copy...> 1 2 3 D 5 6 7 8 .... N 15 16 

Donc, tout est copié sauf la colonne 4 et 14. On notera que les valeurs d'origine D et N dans la colonne 4 et 14 de la ligne cible sont conservées.

Answer 1

Sam

Je ne sais pas exactement comment vous voulez utiliser la macro (? Par exemple sélectionnez-vous gamme en tôle, ou une cellule unique), mais le code suivant peut vous aider à démarrer:

EDIT - code mis à jour pour refléter vos commentaires. J'ai ajouté une fonction pour vérifier si les colonnes que vous voulez conserver sont dans le tableau.

Sub SelectiveCopy() 
'Set range based on selected range in worksheet 

    Dim rngCurrent As Range 
    Set rngCurrent = Selection 

'Define the columns you don't want to copy - here, columns 4 and 14 

    Dim RemoveColsIndex As Variant 
    RemoveColsIndex = Array(4, 14) 

'Loop through copied range and check if column is in array 

Dim iArray As Long 
Dim iCell As Long 

For iCell = 1 To rngCurrent.Cells.Count 
    If Not IsInArray(RemoveColsIndex, iCell) Then 
     rngCurrent.Cells(iCell).Value = rngCurrent.Cells(iCell).Offset(-1, 0) 
    End If 
Next iCell 

End Sub 

Function IsInArray(MyArr As Variant, valueToCheck As Long) As Boolean 
Dim iArray As Long 

    For iArray = LBound(MyArr) To UBound(MyArr) 
     If valueToCheck = MyArr(iArray) Then 
      IsInArray = True 
      Exit Function 
     End If 
    Next iArray 

InArray = False 
End Function 

En fonction de ce que vous voulez faire, vous pouvez augmenter ce code. Par exemple, plutôt que de sélectionner la plage que vous souhaitez copier, vous pouvez cliquer sur une cellule de la ligne, puis utilisez ce qui suit pour sélectionner le EntireRow puis effectuez l'opération de copie:

Set rngCurrent = Selection.EntireRow 

Hope this helps

Answer 2

Essayez d'utiliser l'union de 2 gammes:

Union(Range("Range1"), Range("Range2")) 

Answer 3

Une autre façon de le faire ..... prend moins de. des boucles.

Hypothèses
1. Les colonnes de saut sont dans l'ordre croissant.
2. La valeur de saut de colonnes commence à 1 et non à 0.
3. Range ("Source") est la première cellule dans les données source.
4. Range ("Target") est la première cellule dans les données de la cible.

Sub SelectiveCopy(rngSource As Range, rngTarget As Range, intTotalColumns As Integer, skipColumnsArray As Variant) 

If UBound(skipColumnsArray) = -1 Then 
    rngSource.Resize(1, intTotalColumns).Copy 
    rngTarget.PasteSpecial (xlPasteValues) 
Else 

    Dim skipColumn As Variant 
    Dim currentColumn As Integer 

    currentColumn = 0 

    For Each skipColumn In skipColumnsArray 
     If skipColumn - currentColumn > 1 Then 'Number of colums to copy is Nonzero.' 
      rngSource.Offset(0, currentColumn).Resize(1, skipColumn - currentColumn - 1).Copy 
      rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues) 
     End If 

     currentColumn = skipColumn 
    Next 

    If intTotalColumns - currentColumn > 0 Then 
     rngSource.Offset(0, currentColumn).Resize(1, intTotalColumns - currentColumn).Copy 
     rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues) 
    End If 

End If 

Application.CutCopyMode = False 

End Sub 

Comment appeler:

SelectiveCopy Range("Source"), Range("Target"), 20, Array(1)  'Skip 1st column' 
SelectiveCopy Range("Source"), Range("Target"), 20, Array(4,5,6) 'Skip 4,5,6th column' 
SelectiveCopy Range("Source"), Range("Target"), 20, Array()  'Dont skip any column. Copy all. 

Merci.