Double action

[POLO]

Bonsoir à tous et à toutes

J'ai une macro dans laquelle je veux faire 2 opérations :

La première est la suivante


Sub Commattendues()
'
' Commattendues Macro
' '
Dim d As Integer
With Worksheets('feuil2')
d = Range('A65536').End(xlUp).Row
End With

Range('B3:B27,e3:e27,F3:F27,G3:G27,L3:L27,m3:m27').Select
Range('b3').Activate
Selection.Copy
Sheets('Commissions Attendues').Select

Dim y As Integer
With Worksheets('Commissions Attendues')
y = Range('A65536').End(xlUp).Row
End With
y1 = y + 1
Range('A' & y1 & ' ').Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Sheets('Feuil2').Select
Range('B3').Select

End Sub

La deuxième :

Sub TRANSFERT()
'
' TRANSFERT Macro
'
'
Worksheets('feuil2').Activate
Dim a As Integer
With Worksheets('feuil2')
a = Range('A65536').End(xlUp).Row
End With

Range('B3:B27,F3:F27,G3:G27,L3:L27').Select
Range('L3').Activate
Selection.Copy
Sheets('Transfert').Select

Dim i As Integer
With Worksheets('Transfert')
i = Range('A65536').End(xlUp).Row
End With
i1 = i + 1
Range('A' & i1 & ' ').Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range('a3').Select

Sheets('Feuil2').Select
Range('B3').Select

End Sub

Les 2 macros sont presque jumelles.
Le but est de prendre des données différentes dans une feuille (feuil2)et de les tranférées dasn 2 feuilles différentes au travers de la même macros
Actuellement les deux macros marchent très bien séparément mais je ne trouve pas le truc pour les mettre ensembles dans une seule .

Merci pour le tuyau si vous en avez un.

 

[Hervé]

bonsoir POLO, le forum

sans trop avoir testé, peut etre comme ceci :

Public Sub autrechose()
Dim plage As Range
Dim feuille As Worksheet
Dim i As Byte
Dim ws As Worksheet

Set ws = ActiveSheet
Application.ScreenUpdating = False

For i = 1 To 2
If i = 1 Then
Set plage = ws.Range('B3:B27,e3:e27,F3:F27,G3:G27,L3:L27,m3:m27')
Set feuille = Worksheets('Commissions Attendues')
Else
Set plage = ws.Range('B3:B27,F3:F27,G3:G27,L3:L27')
Set feuille = Worksheets('Transfert')
End If
plage.Copy
With feuille
derligne = .Range('A65536').End(xlUp).Row + 1
.Select
.Range('a' & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
Set plage = Nothing
Next i

End Sub

salut

Message édité par: hervé, à: 03/04/2006 22:51

 

[POLO]

Bonsoir Hervé, bonsoir le forum.

Merci pour la rapidité de ta réponse. Aujourd'hui j'ai pu intégrer ton code et cela marche impeccable et c'est effectivement plus simple comme cela.
Merci beaucoup, je pense que ton code me servira pour developper d'autre chose.

A bientôt sans doute