XL 2010 Copier/coller des cellules non contiguës dans un nouveau classeur

[MisterT]

Bonjour,

Étant très peu connaissant en VBA Excel, j’ai besoin d’aide d’experts pour solutionner mon besoin. Je remercie donc à l’avance celui ou ceux qui prendront de leur précieux temps et expertise pour m’aider !

J’arrive à prendre une plage de cellule d’une Feuille et les copier dans un nouveau classeur dans cette même plage, puis en faire un fichier CSV mais ce dernier contient plusieurs cellules (lignes) non désirées avec plusieurs virgules continues ainsi que des données séparées par plusieurs virgules non désirées

Je veux donc sélectionner les cellules non contiguës et les copier dans le nouveau classeur à partir de "A1" en s’assurant que les cellules d’une même ligne demeurent sur cette même rangée et qui seront séparées que par une seule virgule dans le CSV, donc, sans virgule indésirables séparant les datas.

Ex. : Range("B1:L7,F10:H11,I10:J11,K10:L11,C26:J26") à copier comme ceci :

B1 :L7 (cellules fusionnées) à copier dans A1

F10 :H11 (cellules fusionnées) à copier dans A2, I10 :J11 (cellules fusionnées) à copier dans B2, K10 :L11 (cellules fusionnées) à copier dans C2

C26 :J26 (plage cellules individuelles) à copier dans A3

Voici le code que j’ai actuellement qui fonctionnait si je copiais de plage à plage :

Sub CSV_En()
    Sheets("Source").Select
   
    ' Range("A1:M38").Select 
    ' Range("A1:M38").Copy   Plage copiée qui fonctionnait

    Range("B1:L7,F10:H11,I10:J11,K10:L11,C26:J26").Select
    Range("B1:L7,F10:H11,I10:J11,K10:L11,C26:J26").Copy

    Workbooks.Add
       
    ActiveSheet.Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
   
    Application.CutCopyMode = False

    fname = Application.GetSaveAsFilename(InitialFileName:="C:\Bureau\TEST_En_" & Year(Date) & "-" & Right("0" & Month(Date), 2) & "-" & Right("0" & Day(Date), 2), FileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Save As")
   
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV
   
End Sub

Merci beaucoup !

 

[MisterT]

Bon, j'y suis arrivé en faisant ce qui suit pour montrer ma logique d'apprenti:

Sub CSV_En()
    Sheets("Source").Select
 
    Range("B1:L37").Select
    Range("B1:L37").Copy

    'Range("B1:L7,F10:H11,I10:J11,K10:L11,C26:J26").Select
    'Range("B1:L7,F10:H11,I10:J11,K10:L11,C26:J26").Copy

    Workbooks.Add
     
    ActiveSheet.Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
    Range("A1:L38").UnMerge
   
    ActiveSheet.Range("A1").Copy Destination:=ActiveSheet.Range("A1")
    ActiveSheet.Range("E10").Copy Destination:=ActiveSheet.Range("A2")
    ActiveSheet.Range("H10").Copy Destination:=ActiveSheet.Range("B2")
    ActiveSheet.Range("J10").Copy Destination:=ActiveSheet.Range("C2")
    ActiveSheet.Range("G13").Copy Destination:=ActiveSheet.Range("A3")
    ActiveSheet.Range("B21").Copy Destination:=ActiveSheet.Range("A4")
    ActiveSheet.Range("D21").Copy Destination:=ActiveSheet.Range("B4")
    ActiveSheet.Range("G21:K21").Copy Destination:=ActiveSheet.Range("C4:F4")
       
    ActiveSheet.Range("A10:L38").Clear
    ActiveSheet.Range("A1:L20").Select
    ActiveSheet.Range("A1:L20").Copy
   
    ActiveSheet.Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
    Application.CutCopyMode = False

    fname = Application.GetSaveAsFilename(InitialFileName:="C:\Bureau\TEST_En_" & Year(Date) & "-" & Right("0" & Month(Date), 2) & "-" & Right("0" & Day(Date), 2), FileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Save As")
 
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV
 
End Sub

Le seul problème restant est lorsque le fichier CSV est ouvert, les lignes de quelques datas finissent toutes par plusieurs virgules que j'aimerais bien m'assurer d'enlever dans la VBA ci-haut. J'ai l'impression qu'étant donné la zone de cellules étant jusqu'à la colonne "L", toutes les cellules vides d'une ligne ne se rendant pas à la colonne "L" deviennent des virgules.

Si quelqu'un a une solution, elle est la bienvenue...
Merci !

 

[cp4]

Bonjour MisterT,

Tu aurais pu te demander pourquoi tu n'as eu aucune réponse après 49 visionnages de ta discussion.

Un fichier exemple avec données non confidentielles serait le bienvenu.

Bonne journée.

 

[MisterT]

Bonjour cp4,

Merci pour ton message !

Il y a plusieurs années que je n'avais pas ouvert de discussion, donc peu familier avec le site. Je n'ai pas vu qu'il y avait eu 49 visionnages et j'ignore où cela est indiqué, désolé !

Je suis d'accord qu'un fichier aurait probablement suscité plus d'intérêt pour apporter de l'aide. Il m'apparaissait plus simple et rapide pour moi de tenter de décrire du mieux possible le besoin car la feuille a beaucoup plus d'information que le code montré.

Je constate que l'utilisation de fichiers est beaucoup plus facile et donc plus fréquente qu'auparavant.

J'irai dans ce sens la prochaine fois...

Merci et bonne journée,
Cordialement, MisterT

 

[Staple1600]

Bonjour le fil, Mister T, cp4

En me basant sur les explications et donc sur un fichier créé ex nihilo, le code VBA ci-dessous fonctionne.
(pour la partie copie des cellules fusionnées)

Sub test_ok()
Dim c As Range, t(4), i%
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
If c.Address = c.MergeArea(1).Address Then
t(i) = c.Value
i = i + 1
End If
End If
Next
Workbooks.Add
ActiveSheet.Cells(1).Resize(UBound(t) + 1) = Application.Transpose(t)
End Sub

Mais si cela fonctionne dans ma réalité, est-ce cela fonctionnera dans la réalité de MisterT?
Effectivement un fichier exemple joint au 1er message aurait permis de lever le voile sur cette question existentielle.