Exporter une collection d'onglet vers un autre workbook

Bonjour le forum,

Je voudrais que les onglet rouge (RGB 255 0 0) soient exporté (valeurs) vers un autre workbook, plus exactement certaines colonnes de ces onglets.

Les colonnes à copier sont A à E et I à J

Les onglets "rouges" sont aussi listé automatiquement dans l'onglet "Legend" colonne F (a partir de 2)

J'ai déjà un bout de code qui exporte 1 onglet complet, mais j'ai difficile avec la "collection" à sélectionner...

Voic le code (avec beaucoup de ligne à ne pas exécuter...) :

Sub SaveForField()

  ' Partie Excel
 'Identification du répertoire de sauvegarde
  RepertoryPath = "C:\Cleanpatch\" & Sheets("Legend").Range("I2").Text & "\"

  ' Vérifier si chemin existe avec l'année, sinon le créer
  If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath

  ' Nom du fichier
  FileName = Sheets("Legend").Range("I2").Text
  ' & " " & _ Format(Date, "dd-mm-yy") & "_" & Format(Time, "hh-mm")

  ' Enregistrer-sous
  'ActiveWorkbook.SaveAs (RepertoryPath & FileName)

  ' Partie Excel Simple
  Dim Wb As Workbook
  Dim shtName As String
  Dim Wbe As Workbook

  ' Récupérer le nom de l'onglet
  shtName = Sheets("Legend").Range("F2").Value
  ' le déverrouiiler
  'Sheets(shtName).Unprotect "MDP"
  Set Wbe = ThisWorkbook

  ' Le copier
  ThisWorkbook.Sheets(shtName).Copy
  Set Wb = ActiveWorkbook
  With Wb.Sheets(1).Cells
    .Copy
    .PasteSpecial Paste:=xlPasteValues
  End With
  ' Nom du sheet
    ActiveSheet.Name = "Field " & Wbe.Sheets("Legend").Range("F2").Text

  ' Nom du fichier
  FileName = "For Field " & Wbe.Sheets("Legend").Range("I2").Text & _
  Format(Date, "dd-mm-yy") & "_" & Format(Time, "hh-mm")

    ' Enregistrer-sous
  Wb.SaveAs (RepertoryPath & FileName)

  ' Le re-vérouiller
  'Wbe.Activate
  'Sheets(shtName).Protect Password:="MDP"

   ' envoyer par mail
  'If MsgBox("Voulez-vous l'envoyer par email?", vbYesNo) = vbYes Then
  '    Call Email_excel_simple.EnvoyerMailResumExcel(RepertoryPath, FileName)
  'End If
  Application.ScreenUpdating = True

End Sub

Pourriez-vous m'aider svp

Merci d'avance

voici le fichier...

Multipost

Relis la charte...

Bonjour,

Bien vu 78chris !

@Heavy :

Le cross posting n'est pas toléré sur ce forum.
Vous auriez pu idéalement signaler votre demande effectuée sur un autre forum

Je clôture ici à moins de respecter la charte que je vous invite à lire -- https://forum.excel-pratique.com/excel/a-lire-avant-de-poster-charte-du-forum-et-informations-utiles...

Ne postez pas la même question sur un autre forum pour éviter de faire perdre bêtement du temps aux membres sur un problème qui peut être déjà résolu sur l'autre forum. L'inverse est également valable, si vous avez déjà posé votre question sur un autre forum, ne créez pas un doublon sur ce forum (à moins d'avoir clôturé le sujet sur l'autre forum).

Je vous laisse le choix de vous informer si vous continuez ici ou pas

Cordialement

Je m'excuse pour la gène ocasionnée, je viens de faire une demande pour supprimer le poste sur l'autre site. Pouvez-vous le laisser ouvert sur celui-ci svp.

Je m'excuse pour la gène ocasionnée, je viens de faire une demande pour supprimer le poste sur l'autre site. Pouvez-vous le laisser ouvert sur celui-ci svp.

Ok. Pas de soucis, je laisse le fil ouvert.

Par rapport à votre demande je pense que c'est aussi Chris qui vous a répondu sur l'autre forum.

Pour ma part, si l'on se tient à traiter le souci via code VBA, j'ai les questions suivantes :
- Est-ce que vous devez sauvegarder chaque feuille dont le nom est mentionné en colonne F dans un nouveau fichier ou toutes les feuilles dans un seul fichier ?
- Dans chacun des feuilles vous avez des lignes vides. Je suppose que vous avez supprimé les données ? Cette remarque parce que vous utilisez des tableaux au format structuré et dans ce cas, il ne faut jamais de lignes sans données

En effet, chris avais répondu sur l'autre forum.

Pour répondre à vos questions,

- Toutes les feuilles doivent être ensemble dans un seul fichier dont le nom est défini dans la macro existante

- Dans les tableau je n'ai pas supprimé de données, mais il ne va contenir que les données qui s'y trouve.

Pour info, le sheet "K25341 (122949) (2)" affiche les colonnes à tenir

Re

Essayez votre code comme ceci

Sub SaveForField()
Dim nomfichier As String

nomfichier = ThisWorkbook.Sheets("Legend").Range("I2").Text ' Nom du fichier
RepertoryPath = "C:\Cleanpatch\" & nomfichier & "\" 'Identification du répertoire de sauvegarde

' Vérifier si chemin existe avec l'année, sinon le créer
If Dir(RepertoryPath, vbDirectory) = "" Then MkDir RepertoryPath

Dim Wb As Workbook
Dim shtName As String
Dim nomfichierwb As String
Dim dcol As String 'modifié Dan

For i = 2 To ThisWorkbook.Sheets("Legend").Range("F" & Rows.Count).End(xlUp).Row

    shtName = ThisWorkbook.Sheets("Legend").Range("F" & i).Value ' Récupérer le nom de l'onglet
    ' le déverrouiiler
    'Sheets(shtName).Unprotect "MDP"
    If i = 2 Then
        ThisWorkbook.Sheets(shtName).Copy ' copier la feuille
        Set Wb = ActiveWorkbook
    Else: ThisWorkbook.Sheets(shtName).Copy after:=Wb.Sheets(Sheets.Count)
    End If

    With Wb.Sheets(i - 1).Cells
      .Copy
      .PasteSpecial Paste:=xlPasteValues

    End With
    With Wb.ActiveSheet
        dcol = Cells(2, .ListObjects(1).ListColumns.Count).Address
        .Range("K2:" & dcol).EntireColumn.Delete
        .Range("F2:H2").EntireColumn.Delete
        .Name = "Field " & ThisWorkbook.Sheets("Legend").Range("F" & i).Text 'Nom onglet
    End With
Next i

nomfichierwb = "For Field " & nomfichier & " " & Format(Date, "dd-mm-yy") & "_" & Format(Time, "hh-mm") ' Nom du fichier
Wb.SaveAs ThisWorkbook.Path & "\" & nomfichierwb ' Enregistrer-sous
Wb.SaveAs RepertoryPath & nomfichierwb ' Enregistrer-sous
End Sub

Si ok pensez à

Cordialement

Bonjour Dan,

merci pour le code.

Malheureusement je viens de l'essayer et j'obtient une erreur "Run-time error 13 Type mismatch" au niveau de

dcol = Cells(2, .ListObjects(1).ListColumns.Count).Address

Bonjour

Malheureusement je viens de l'essayer et j'obtient une erreur "Run-time error 13 Type mismatch"

Oups oui effectivement.
Il faut remplacer la déclaration de variable Dim dcol as Byte par Dim dcol as string.
J'ai modifié la ligne dans mon post précédent (j'ai ajouté la mention "modifié Dan"). Cela devrait fonctionner

Au delà de cette modification vous pouvez aussi remplacer la ligne dcol = .... par ceci

dcol = .Cells(.ListObjects(1).HeaderRowRange.Row, .ListObjects(1).ListColumns.Count).Address

Oubliez pas de remplir toutes vos lignes. Pas de lignes sans données dans un tableau structuré

Cordialement

Merci, cela fonctionne bien maintenant.

Je dois juste encore "jouer" pour les colonnes a effacer ou pas, mais je pense y arriver en modifiant les lignes après le "dcol = "

Juste pour mon info personnelle, quel est la différence entre les 2 lignes "dcol =" proposées?

re

Je dois juste encore "jouer" pour les colonnes a effacer ou pas, mais je pense y arriver en modifiant les lignes après le "dcol = "

Non si vous voulez changer les colonnes à supprimer, vous devez le faire dans les les lettres deux lignes Range.... en dessous de dcol =.cells(......

Juste pour mon info personnelle, quel est la différence entre les 2 lignes "dcol =" proposées?

Simplement que dans le code précédent j'imposais la ligne 2 dans la ligne dcol= .cells(2,...
Comme votre tableau est au format structuré, on peut remplacer le 2 par l'instruction Headerrowrange qui représente la ligne de titre de votre tableau structuré.
L'avantage est que si par exemple vous insérez une ligne en ligne 1 de votre feuille, les titres du tableau seront placés en ligne 3. Dans ce cas vous devriez adapter la ligne dcol = .cells(2, .... par dcol = .cells(3, .....
En remplaçant le 2 par Headerrowrange, le code le verra automatiquement la nouvelle ligne de titre (donc 3 dans mon exemple)

Vous comprenez ?

Par contre il faudra changer les lettres dans les lignes Range. Je vais regardez ce point et vous donner l'adaptation

Cordialement

Edit : Voici ce que vous devez faire
1. En dessous de la ligne Dim dcol as string, ajoutez ceci

Dim lig As Byte

2. Remplacez les deux lignes Range(K2 ...... et Range ("F2:H2.....) par ces trois lignes

 lig = .ListObjects(1).HeaderRowRange.Row
.Range("K" & lig & ":" & dcol).EntireColumn.Delete
.Range("F" & lig & ":H" & lig).EntireColumn.Delete

Important : si vous changez les lignes vous devez toujours veiller à commencer par la colonne plus à droite (donc ici K) et finir par la colonne la plus à gauche sur votre feuille

C'est bien des lignes "Range" dont je parlais pour la suppression des colonnes.

Et merci pour l'explication, très instructif, et cela rend le code très souple.

Merci beuacoup, et encore désolé pour le double post.