Mettre mon classeur dans le bon ordre

[ericTA]

Bonjour,
J'ai une macro qui copie les feuilles d'un fichier source vers un fichier cible une à une.
Seulement voilà dans mon fichier cible les feuilles sont classées à l'envers.
Comment faire pour les avoir dans le même ordre.
Help.

Sub collage(FichierSource, FichierCible)
Dim ws As Worksheet

Windows(FichierSource).Activate
For Each ws In Worksheets
If Sheets(ws.Name).Range("A2").Value = "ONGLET" Then
Windows(FichierSource).Activate
Sheets(ws.Name).Select
Columns("B:E").Select
Range("B3").Activate
Selection.Copy
Windows(FichierCible).Activate
Sheets.Add.Name = ws.Name
Columns("A😀").Select
Range("A2").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(FichierSource).Activate

End If
Next ws
End Sub
Merci d'avance
Eric

 

[Bernard_XLD]

Re : Mettre mon classeur dans le bon ordre

Bonjour

le plus simple, faire les copies à l'envers
pas testé mais devrait fonctionner

A+

Sub collage(FichierSource, FichierCible)
Dim Wkb_O As Workbook, Compteur As Integer
Windows(FichierSource).Activate
Set Wkb_O = ActiveWorkbook
For Compteur = Wkb_O.Worksheets.Count To 1 Step -1
If Wkb_O.Sheets(Compteur).Range("A2").Value = "ONGLET" Then
Wkb_O.Sheets(Compteur).Columns("B:E").Copy
Windows(FichierCible).Activate
Sheets.Add.Name = Sheets(Compteur).Name
Columns("A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next Compteur
Wkb_O.Activate
End Sub

 

[Bernard_XLD]

Re : Mettre mon classeur dans le bon ordre

une petite erreur sur le nom de la feuille destination

Sub collage(FichierSource, FichierCible)
Dim Wkb_O As Workbook, Compteur As Integer
Windows(FichierSource).Activate
Set Wkb_O = ActiveWorkbook
For Compteur = Wkb_O.Worksheets.Count To 1 Step -1
If Wkb_O.Sheets(Compteur).Range("A2").Value = "ONGLET" Then
Wkb_O.Sheets(Compteur).Columns("B:E").Copy
Windows(FichierCible).Activate
Sheets.Add.Name = Wkb_O.Sheets(Compteur).Name
Columns("A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next Compteur
Wkb_O.Activate
End Sub

 

[Bernard_XLD]

Re : Mettre mon classeur dans le bon ordre

le même en simplifié et sans select

Sub collage(FichierSource, FichierCible)
Dim Wkb_O As Workbook, Wkb_C As Workbook, Ws_C As Worksheet, Compteur As Integer
Windows(FichierSource).Activate
Set Wkb_O = ActiveWorkbook
Windows(FichierCible).Activate
Set Wkb_C = ActiveWorkbook
For Compteur = Wkb_O.Worksheets.Count To 1 Step -1
If Wkb_O.Sheets(Compteur).Range("A2").Value = "ONGLET" Then
    Set Ws_C = Wkb_C.Sheets.Add
    Ws_C.Name = Wkb_O.Sheets(Compteur).Name
    'copie les cellules
    Wkb_O.Sheets(Compteur).Columns("B:E").Copy Destination:=Ws_C.Columns("A:D")
    'écrase avec les valeurs s'il y a des formules dans la feuille origine
    Ws_C.Columns("A:D").Value = Wkb_O.Sheets(Compteur).Columns("B:E").Value
End If
Next Compteur
Wkb_O.Activate
End Sub

 

[kjin]

Re : Mettre mon classeur dans le bon ordre

Bonjour,
Il me semble qu'en utilisant l'argument after à l'ajout d'une nouvelle feuille cela permet de les remettre dans l'ordre, car par défaut les nouvelles feuilles viennent se placer avant la feuille active.

Sub collage(FichierSource, FichierCible)
Dim ws As Worksheet
Windows(FichierSource).Activate
For Each ws In Worksheets
If Sheets(ws.Name).Range("A2").Value = "ONGLET" Then
Sheets(ws.Name).Range("B3").Copy
Windows(FichierCible).Activate
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Ws.Name
Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False
Windows(FichierSource).Activate
End If
Next ws
End Sub

A tester
A+
kjin

 

[ericTA]

Re : Mettre mon classeur dans le bon ordre

Merci
La dernière solution marche super bien (je n'ai pas essayé les autres).
Encore MERCI
Eric