marcro copier coller

biba78 · 12 Octobre 2016

Bonjour à tous,
j'ai besoin de votre aide.
pour mon fichier Excel, j'ai besoin d'une macro pour copier mes du 1er onglet les données importées d'une application dans un 2éme onglet en changeant l'ordre des colonnes.( voir l'exemple joint)
en vous remerciant par avance.

DoubleZero · 12 Octobre 2016

Bonjour, biba78, le Forum,

Attention aux espaces superflus dans le nom des onglets.

Un essai avec le code suivant.

Code:

Option Explicit
Sub Copier_coller()
    Dim a As Object, b As Object
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Set a = Sheets("Extraction")
    Set b = Sheets("liste finale")
    b.Columns("a:h").Clear
    With a
        .Columns("f:f").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("a1")
        .Columns("h:h").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("b1")
        .Columns("g:g").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("c1")
        .Columns("a:e").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("d1")
    End With
    Cells.EntireColumn.AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt

Staple1600 · 12 Octobre 2016

Bonjour à tous, 00

Une autre macro

VB:

Sub a()
With Sheets("Extraction")
    .Columns("F:H").Copy Sheets("liste finale ").Range("A1")
    Application.CutCopyMode = False
    .Columns("A:E").Copy Sheets("liste finale ").Range("D1")
    Application.CutCopyMode = False
End With
End Sub

Même remarque que 00, il y a un espace dans le nom de la feuille Extraction.
Il faut donc le supprimer.

EDITION: je viens de voir que j'avais laissé l'espace dans le nom de la feuille liste finale.
Donc soit supprimer l'espace dans la macro et dans le nom de la feuille
soit ne rien faire

biba78 · 17 Octobre 2016

Merci à tous
espace supprimé

très bonne journée à tous

biba78 · 20 Octobre 2016

Re bonjour,
je voulais insérer un bouton en haut de la"feuille Liste finale" , et lui affecter la macro, mais elle ne fonctionne plus,
j'ai encore besoin de votre aide
cordialement

DoubleZero · 20 Octobre 2016

Bonjour, biba78, Staple1600 , le Forum,

biba78 à dit:
...elle ne fonctionne plus...

Parce que la présentation du dernier fichier déposé est différente...

VB:

Option Explicit
Sub Copier_coller_v2()
    Dim a As Object, b As Object
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Set a = Sheets("Extraction")
    Set b = Sheets("liste finale")
    b.Columns("a:h").Clear
    With a
        .Rows("1:3").EntireRow.Hidden = True
        .Columns("f:f").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("a1")
        .Columns("h:h").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("b1")
        .Columns("g:g").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("c1")
        .Columns("a:e").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("d1")
        Rows("1:3").EntireRow.Hidden = False
    End With
    Cells.EntireColumn.AutoFit
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt

biba78 · 20 Octobre 2016

DoubleZero à dit:
Sub Copier_coller_v2()
Dim a As Object, b As Object
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Set a = Sheets("Extraction")
Set b = Sheets("liste finale")
b.Columns("a:h").Clear
With a
.Rows("1:3").EntireRow.Hidden = True
.Columns("f:f").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("a1")
.Columns("h:h").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("b1")
.Columns("g:g").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("c1")
.Columns("a:e").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy b.Range("d1")
Rows("1:3").EntireRow.Hidden = False
End With
Cells.EntireColumn.AutoFit
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

DoubleZero · 20 Octobre 2016

Re-bonjour,

Mais encre ?

A bientôt

marcro copier coller

biba78

XLDnaute Junior

Pièces jointes

DoubleZero

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

biba78

XLDnaute Junior

biba78

XLDnaute Junior

Pièces jointes

DoubleZero

XLDnaute Barbatruc

biba78

XLDnaute Junior

DoubleZero

XLDnaute Barbatruc

Discussions similaires