Copier/Coller différentes plages

Le
Guy85
Bonjour,
Dans la feuille "Récap":
Je copie "A5:G5 + H5:N5 + O5:AC5 puis AD5:AF5"
Je colle dans la feuille "Données" :
A5:G5 en F + H5:N5 en S + O5:AC5 en AF puis en BA.
J'ai le code suivant:

Sub Essai_Transfert()
Application.ScreenUpdating = False
Range("A5:G5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("F65535").End(xlUp).Row + 2
Range("F" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.ScreenUpdating = False
Sheets("Récap").Select
Range("H5:N5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("S65535").End(xlUp).Row + 2
Range("S" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

..etc

ça fonctionne, mais je pense qu'il y a plus simple ?
J'ai essayé avec le l'éditeur de macro et la touche "Ctrl" mais cela me le
colle en une seule fois sans les espaces.
Merci de votre aide.
--
Cordialement
Guy
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Hervé
Le #21100251
Bonsoir Guy,

Teste ceci :

Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

Application.ScreenUpdating = False

'adapter les adresses car pas sûr !
With FeRecap
.[A5:G5].Copy FeEssai.[F65535].End(xlUp).Offset(2, 0)
.[H5:N5].Copy FeEssai.[M65535].End(xlUp).Offset(2, 0)
.[O5:AC5].Copy FeEssai.[T65535].End(xlUp).Offset(2, 0)
.[AD5:AF5].Copy FeEssai.[AI65535].End(xlUp).Offset(2, 0)
End With

Application.ScreenUpdating = True

End Sub


Hervé.



"Guy85" news:%
Bonjour,
Dans la feuille "Récap":
Je copie "A5:G5 + H5:N5 + O5:AC5 puis AD5:AF5"
Je colle dans la feuille "Données" :
A5:G5 en F + H5:N5 en S + O5:AC5 en AF puis en BA.
J'ai le code suivant:

Sub Essai_Transfert()
Application.ScreenUpdating = False
Range("A5:G5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("F65535").End(xlUp).Row + 2
Range("F" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.ScreenUpdating = False
Sheets("Récap").Select
Range("H5:N5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("S65535").End(xlUp).Row + 2
Range("S" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

........etc

ça fonctionne, mais je pense qu'il y a plus simple ?
J'ai essayé avec le l'éditeur de macro et la touche "Ctrl" mais cela me le
colle en une seule fois sans les espaces.
Merci de votre aide.
--
Cordialement
Guy



Hervé
Le #21100421
Bonsoir Guy,
Teste ceci pour voir si ça te va :
Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

Application.ScreenUpdating = False

'adapter les adresses car pas sûr !
With FeRecap
.[A5:G5].Copy FeEssai.[F65535].End(xlUp).Offset(2, 0)
.[H5:N5].Copy FeEssai.[M65535].End(xlUp).Offset(2, 0)
.[O5:AC5].Copy FeEssai.[T65535].End(xlUp).Offset(2, 0)
.[AD5:AF5].Copy FeEssai.[AI65535].End(xlUp).Offset(2, 0)
End With

Application.ScreenUpdating = True

End Sub

Hervé.



"Guy85" news:%
Bonjour,
Dans la feuille "Récap":
Je copie "A5:G5 + H5:N5 + O5:AC5 puis AD5:AF5"
Je colle dans la feuille "Données" :
A5:G5 en F + H5:N5 en S + O5:AC5 en AF puis en BA.
J'ai le code suivant:

Sub Essai_Transfert()
Application.ScreenUpdating = False
Range("A5:G5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("F65535").End(xlUp).Row + 2
Range("F" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.ScreenUpdating = False
Sheets("Récap").Select
Range("H5:N5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("S65535").End(xlUp).Row + 2
Range("S" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

........etc

ça fonctionne, mais je pense qu'il y a plus simple ?
J'ai essayé avec le l'éditeur de macro et la touche "Ctrl" mais cela me le
colle en une seule fois sans les espaces.
Merci de votre aide.
--
Cordialement
Guy



Guy85
Le #21100381
Bonsoir Hervé,
Merci de me répondre
ça copie bien avec le format, mais je souhaiterais avoir la copie que des
valeurs.
Guy

"Hervé"
Bonsoir Guy,
Teste ceci pour voir si ça te va :
Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

Application.ScreenUpdating = False

'adapter les adresses car pas sûr !
With FeRecap
.[A5:G5].Copy FeEssai.[F65535].End(xlUp).Offset(2, 0)
.[H5:N5].Copy FeEssai.[M65535].End(xlUp).Offset(2, 0)
.[O5:AC5].Copy FeEssai.[T65535].End(xlUp).Offset(2, 0)
.[AD5:AF5].Copy FeEssai.[AI65535].End(xlUp).Offset(2, 0)
End With

Application.ScreenUpdating = True

End Sub

Hervé.



"Guy85" news:%
Bonjour,
Dans la feuille "Récap":
Je copie "A5:G5 + H5:N5 + O5:AC5 puis AD5:AF5"
Je colle dans la feuille "Données" :
A5:G5 en F + H5:N5 en S + O5:AC5 en AF puis en BA.
J'ai le code suivant:

Sub Essai_Transfert()
Application.ScreenUpdating = False
Range("A5:G5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("F65535").End(xlUp).Row + 2
Range("F" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.ScreenUpdating = False
Sheets("Récap").Select
Range("H5:N5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("S65535").End(xlUp).Row + 2
Range("S" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

........etc

ça fonctionne, mais je pense qu'il y a plus simple ?
J'ai essayé avec le l'éditeur de macro et la touche "Ctrl" mais cela me
le colle en une seule fois sans les espaces.
Merci de votre aide.
--
Cordialement
Guy






Hervé
Le #21100371
Décidément Grrrr, désolé pour le doublon. Quelques soucis avec ma connexion
:o((

Hervé.


"Hervé" news:
Bonsoir Guy,
Teste ceci pour voir si ça te va :
Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

Application.ScreenUpdating = False

'adapter les adresses car pas sûr !
With FeRecap
.[A5:G5].Copy FeEssai.[F65535].End(xlUp).Offset(2, 0)
.[H5:N5].Copy FeEssai.[M65535].End(xlUp).Offset(2, 0)
.[O5:AC5].Copy FeEssai.[T65535].End(xlUp).Offset(2, 0)
.[AD5:AF5].Copy FeEssai.[AI65535].End(xlUp).Offset(2, 0)
End With

Application.ScreenUpdating = True

End Sub

Hervé.



"Guy85" news:%
Bonjour,
Dans la feuille "Récap":
Je copie "A5:G5 + H5:N5 + O5:AC5 puis AD5:AF5"
Je colle dans la feuille "Données" :
A5:G5 en F + H5:N5 en S + O5:AC5 en AF puis en BA.
J'ai le code suivant:

Sub Essai_Transfert()
Application.ScreenUpdating = False
Range("A5:G5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("F65535").End(xlUp).Row + 2
Range("F" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

Application.ScreenUpdating = False
Sheets("Récap").Select
Range("H5:N5").Select
Selection.Copy
Sheets("Essai").Select
derligne = Range("S65535").End(xlUp).Row + 2
Range("S" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse
Application.ScreenUpdating = True
Application.CutCopyMode = False

........etc

ça fonctionne, mais je pense qu'il y a plus simple ?
J'ai essayé avec le l'éditeur de macro et la touche "Ctrl" mais cela me
le colle en une seule fois sans les espaces.
Merci de votre aide.
--
Cordialement
Guy






Charabeuh
Le #21101741
Bonjour,

En s'appuyant sur la macro de Hervé, une piste ?

Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet
Dim Source As Range
Dim Colonne As String

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

'adapter les adresses car pas sûr !
With FeRecap
Set Source = .Range("A5:G5"): Colonne = "F"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("H5:N5"): Colonne = "S"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("O5:AC5"): Colonne = "AF"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("AD5:AF5"): Colonne = "BA"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
End With

End Sub

Salut
Guy85
Le #21103071
Bonjour,
Merci ça fonctionne.
J'ai juste ajouté ça pour rester sur la feuille "essai"

Sheets("Données").Select
Range("A1").Select

Cordialement
Guy

"Charabeuh" %
Bonjour,

En s'appuyant sur la macro de Hervé, une piste ?

Sub Essai_Transfert()

Dim FeRecap As Worksheet
Dim FeEssai As Worksheet
Dim Source As Range
Dim Colonne As String

Set FeRecap = Worksheets("Recap")
Set FeEssai = Worksheets("Essai")

'adapter les adresses car pas sûr !
With FeRecap
Set Source = .Range("A5:G5"): Colonne = "F"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("H5:N5"): Colonne = "S"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("O5:AC5"): Colonne = "AF"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value

Set Source = .Range("AD5:AF5"): Colonne = "BA"
FeEssai.Range(Colonne & 65535).End(xlUp).Offset(2, 0). _
Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
End With

End Sub

Salut


Publicité
Poster une réponse
Anonyme