XL 2019 Copier tableau avec la mise en forme vers un nouveau classeur

cd95 · 24 Mars 2020

Bonsoir ;

J’ai un fichier pour copier un tableau avec toute sa mise en forme vers un nouveau classeur mais sans copier le code VBA. Tout fonctionne correctement sauf qu’il ne prend pas en compte les chaînes qui contiennent un mot colorié. Y'aura-t-il une personne pour m’aider à ajouter le code qui manque pour que ça fonctionne correctement. Merci

Pounet95 · 24 Mars 2020

Bonsoir,
Sans rien toucher, juste fait "tourner" la macro.
Windows 10 Excel 2016 32bits

cd95 · 24 Mars 2020

Pounet95 à dit:
Bonsoir,
Sans rien toucher, juste fait "tourner" la macro.
Windows 10 Excel 2016 32bits

Regarde la pièce jointe 1059595 Regarde la pièce jointe 1059596

Bonsoir,

J’ai bien vu vos captures et j’avais le même résultat que vous sauf que le problème n’est toujours pas résolu. La colonne des noms et prénoms est restée sans mise en forme à savoir la couleur des mots à l’intérieur des chaînes.

Pounet95 · 24 Mars 2020

Bonsoir,
en rajoutant une ligne :
Range("A1").PasteSpecial xlPasteFormats
Range("A1").PasteSpecial xlPasteValues
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Rajouter cette ligne
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False

cd95 · 25 Mars 2020

Pounet95 à dit:
Bonsoir,
en rajoutant une ligne :
Range("A1").PasteSpecial xlPasteFormats
Range("A1").PasteSpecial xlPasteValues
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Rajouter cette ligne
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False

Bonjour,

Merci beaucoup à vous « Pounet95 » maintenant ça marche comme sur des roulettes. Chapeau

Pounet95 · 25 Mars 2020

Bonjour,
Merci du retour (feedback in English in the text )
Par contre, je viens de vérifier, il faut que cette ligne soit après les autres Pastespecial !
Pourquoi ????

Staple1600 · 25 Mars 2020

Bonjour le fil, cd95, Pounet95

J'ai pondu, je poste
(Cela pourra toujours servir)

VB:

Sub Copie_Feuille()
Dim NewWBK As Workbook
Cells(1).CurrentRegion.Copy
Set NewWBK = Workbooks.Add(1)
    With NewWBK.Sheets(1).Cells(1)
        .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAllUsingSourceTheme
    End With
Application.CutCopyMode = False: Application.DisplayAlerts = False
NewWBK.SaveAs ThisWorkbook.Path & "\copie.xlsx", 51
NewWBK.Close True
End Sub

PS: test OK sur XL 2013

cd95 · 25 Mars 2020

Staple1600 à dit:

Bonjour le fil, cd95, Pounet95

J'ai pondu, je poste
(Cela pourra toujours servir)

VB:

Sub Copie_Feuille()
Dim NewWBK As Workbook
Cells(1).CurrentRegion.Copy
Set NewWBK = Workbooks.Add(1)
    With NewWBK.Sheets(1).Cells(1)
        .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAllUsingSourceTheme
    End With
Application.CutCopyMode = False: Application.DisplayAlerts = False
NewWBK.SaveAs ThisWorkbook.Path & "\copie.xlsx", 51
NewWBK.Close True
End Sub

PS: test OK sur XL 2013

Bonjour,

Je vous remercie pour cette solution qui est mine de rien beaucoup plus propre et efficace que mon ancien code mais le seul bémol ce qu’il écrase l’ancienne sauvegarde (on ne peut pas donc garder les anciennes sauvegardes à moins de le faire manuellement ou bien sûr rajouter un code).

Staple1600 · 25 Mars 2020

Re

•>cd95
Cette macro est fournie en l'état
Charge à son utilisateur de faire les adaptations nécessaires selon ses besoins.

On pourrait envisager l'ajout d'un InputBox pour que l'utilisateur renseigne le nom de fichier à donner à la copie par exemple.

De nombreux exemples de ce genre de choses et plus en dormance dans les archives du forum

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

cd95 · 25 Mars 2020

Staple1600 à dit:
Re

•>cd95
Cette macro est fournie en l'état
Charge à son utilisateur de faire les adaptations nécessaires selon ses besoins.

On pourrait envisager l'ajout d'un InputBox pour que l'utilisateur renseigne le nom de fichier à donner à la copie par exemple.

De nombreux exemples de ce genre de choses et plus en dormance dans les archives du forum

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

Re

Je suis tout à fait d'accord avec vous Staple1600. GRAND merci

Staple1600 · 25 Mars 2020

Re

J'avais oublié que j'étais confiné
Alors CKADO

VB:

Sub Copie_Feuille_BIS()
Dim Nom_SVG, strPath$, NewWBK As Workbook, AWBK As Workbook:: Set AWBK = ThisWorkbook
strPath$ = ThisWorkbook.Path & "\"
Cells(1).CurrentRegion.Copy
Set NewWBK = Workbooks.Add(1)
    With NewWBK.Sheets(1).Cells(1)
        .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAllUsingSourceTheme
    End With
Application.CutCopyMode = False: Application.DisplayAlerts = False
Nom_SVG = _
        CStr(InputBox("Merci de saisir le nom de la copie, svp.", "Backup XLSX", _
        "Copie_" & WBK_Name_Only(AWBK) & Format(Now, "_hhmmss"".xlsx""")))
NewWBK.SaveAs strPath & Nom_SVG, 51
NewWBK.Close True
End Sub
Function WBK_Name_Only(wb As Workbook) As String
WBK_Name_Only = ""
If InStr(wb.Name, ".") > 0 Then
WBK_Name_Only = Left(wb.Name, InStr(wb.Name, ".") - 1)
End If
End Function

cd95 · 25 Mars 2020

Staple1600 à dit:

Re

J'avais oublié que j'étais confiné
Alors CKADO

VB:

Sub Copie_Feuille_BIS()
Dim Nom_SVG, strPath$, NewWBK As Workbook, AWBK As Workbook:: Set AWBK = ThisWorkbook
strPath$ = ThisWorkbook.Path & "\"
Cells(1).CurrentRegion.Copy
Set NewWBK = Workbooks.Add(1)
    With NewWBK.Sheets(1).Cells(1)
        .PasteSpecial xlPasteColumnWidths: .PasteSpecial xlPasteAllUsingSourceTheme
    End With
Application.CutCopyMode = False: Application.DisplayAlerts = False
Nom_SVG = _
        CStr(InputBox("Merci de saisir le nom de la copie, svp.", "Backup XLSX", _
        "Copie_" & WBK_Name_Only(AWBK) & Format(Now, "_hhmmss"".xlsx""")))
NewWBK.SaveAs strPath & Nom_SVG, 51
NewWBK.Close True
End Sub
Function WBK_Name_Only(wb As Workbook) As String
WBK_Name_Only = ""
If InStr(wb.Name, ".") > 0 Then
WBK_Name_Only = Left(wb.Name, InStr(wb.Name, ".") - 1)
End If
End Function

Re
Je voudrais exprimer mon soutien le plus total à toute personne qui vient en aide pour ceux qui en ont besoin d’ailleurs comme le fait ce magnifique forum « XLD » qui parmi beaucoup de ses participants proposent gratuitement leurs ingéniosités à résoudre différents problèmes. Et en fin un grand salut au personnel soignant qui se sacrifie pour le bien commun et qui luttent contre le coronavirus avec un grand courage.

XL 2019 Copier tableau avec la mise en forme vers un nouveau classeur

cd95

XLDnaute Occasionnel

Pièces jointes

Pounet95

XLDnaute Occasionnel

cd95

XLDnaute Occasionnel

Pounet95

XLDnaute Occasionnel

cd95

XLDnaute Occasionnel

Pounet95

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

cd95

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Effectuez une recherche sur Excel Downloads...

cd95

XLDnaute Occasionnel

Effectuez une recherche sur Excel Downloads...

Staple1600

XLDnaute Barbatruc

cd95

XLDnaute Occasionnel

Discussions similaires