VBA copie plusieurs colonnes continues et discontinues longueur variable

Question

Je galère un peu avec les copies de colonnes discontinues je cherche a copier les données des colonnes de la feuil d’origine &#91; f , ijk , n , krs &#93; de la ligne 2 a la dernière ligne rempli en J feuil d’origine vers une feuille destination après vérification d'une date. Copie dans les colonnes &#91; f , ijk , n , krs &#93; de la feuil de destination mais a partir de la 1 ere ligne vide de la colonne J de la feuil destination ps : collage spéciale valeurs (justes les valeurs ) voici mon début de code Sub copie() Dim Fin Dim DLig As Long ' copie plusieurs colonne continue et discontinue longueur variable ' derniere ligne a copier en F06 ' DLig = F06.Range("i" & Rows.Count).End(xlDown).Row F06.Range("f2:f" & F06.Range("i2").End(xlDown).Row).copy F08.Select Fin = Range("J65000").End(xlUp).Row + 1 'je cherche sur la colonne de J ' verifie si conditions date ok pour copie en f08 If Range("A" & Fin) = F06.&#91;a2&#93; Then MsgBox ("ok") Range("j" & Fin).Select 'recherche la première cellule vide' Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'collage special valeur Application.CutCopyMode = False Else MsgBox ("Les dates d'extractions et les dates de la base de données ne correpondent pas") End End If End Sub...

ric · Accepted Answer

Essai ainsi ... car je crois que "Paste" ne peut coller sur une feuille non-active ... For k = 1 To 14 Select Case k Case 1, 4 To 6, 9, 12 To 14 'prend la colonne 5+k des lignes 2 à Dlig ... puis, colle dans colonnes 9+k sur lignes Fin F06.Range(Cells(2, 5 + k), Cells(DLig, 5 + k)).Copy F08.Cells(Fin, 9 + k) End Select Next k ric...

3GB · Accepted Answer

Je n'ai pas vérifié mais je crois tu as raison pour Paste. En tout cas, j'ai appris une nouvelle syntaxe, plus efficace, grâce à ton intervention ! foufie, Je suis content que ça marche. Bonne continuation...

3GB · Answer

Je ne sais pas si ça va marcher mais l'idée est là je crois : F06.Range("F2, I2:K2, N2, Q2:S2").Copy F08.range("j" & Fin).PasteSpecial ... ou F08.range("j" & Fin & ":q" & Fin).PasteSpecial ... '8 cellules copiées donc la zone de destination contient 8 cellules Il y a en plus peut-être la possibilité de factoriser la sélection copiée sur F06 ...

3GB · Answer

Ah, vous souhaitez que le collage respecte la discontinuité ?

Et j'imagine qu'il n'est pas possible de copier de F à S puis de supprimer le contenu des colonnes indésirables ?

Là, je ne vois qu'une option, c'est :

For k = 1 to 14
    select case k
    case 1, 4 to 6, 9, 12 to 14
        F06.range(cells(2, 5 + k), cells(Dlig, 5 + k)).copy 'prend la colonne 5+k des lignes 2 à Dlig
        F08.range(cells(fin, 9 + k), cells(fin + Dlig - 1, 9 + k).pastespecial 'colle dans colonnes 9+k sur lignes Fin à Fin + Dlig -1
    end select
next k

Peut-être qu'il y aura un problème au niveau de la syntaxe du select case mais sur le principe, ça me semble correct, bien que ce ne soit pas la solution la plus attirante...

3GB · Answer

Je vous en prie.

Oui, c'est pas marrant...

Et pas moyen de déplacer les colonnes de manière à ce qu'elles constituent une plage continue ? Je pose la question mais je connais déjà la réponse.

A bientôt,

3GB · Answer

Au fait, au cas où, pour éviter de voir toutes les actions à l'écran, il faut ajouter Application.Screenupdating de part et d'autre de la boucle : Application.Screeupdating = False La Boucle de copier/coller Application.Screeupdating = True...

3GB · Answer

Re foufie, ric,

Je viens de repenser au fait que le code demandé était censé copier valeurs et formats, sans les formules.

A moins que le code de ric - qui n'a probablement pas fait attention à cette contrainte - ne fonctionne, ce dont je doute, il vaudrait mieux garder ce code :

For k = 1 to 14
    select case k
    case 1, 4 to 6, 9, 12 to 14
        F06.range(cells(2, 5 + k), cells(Dlig, 5 + k)).copy 'prend la colonne 5+k des lignes 2 à Dlig
        'F08.activate à rendre opérationnel si nécessaire
        F08.range(cells(fin, 9 + k), cells(fin + Dlig - 1, 9 + k).PasteSpecial Paste:=xlPasteValues 'colle valeurs
        F08.range(cells(fin, 9 + k), cells(fin + Dlig - 1, 9 + k).PasteSpecial Paste:=xlPasteFormats 'colle formats
'dans colonnes 9+k sur lignes Fin à Fin + Dlig -1
    end select
next k

Bonne soirée à tous les 2,

ric · Answer

@3GB &gt;&gt; effectivement &gt; j'ai oublié cette contrainte &gt; désolé &gt; Merci d'avoir fourni un code adapté &gt; ric...

3GB · Answer

Désolé, je saisis directement sur le forum donc je n'ai pas la machine qui m'avertit lorsque je fais une faut de frappe... L'essentiel étant à mes yeux de régler le problème de fond. En tout cas, je suis content pour toi que tout marche maintenant. Bonne journée...