Simplification de macro

[br44]

Bonjour le forum

Voiçi un petit message qui j'èspere trouveras une rèponse . je voudrais savoir comeent simplifier la macro suivantes :

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 10/10/2007 par rimmele
'

'
Range("A12:A13,B12:B13,C12:C13").Select
Range("C12").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End Sub

Cette macro faite avec l'enregisrteur permet de fusionner plusieur plage de cellules en même temps . je voudrais la simplifier de manière à l'inserer par la suite dans la procèdure suivante :
If Range ("G3").Value="C16" Then
With Wb2.Sheets("Annexfacture1")
.Range("C16").Copy
End With
R.Offset(1, 3).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture1")
.Range("F12").Copy
End With
R.Offset(1, 4).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture1")
.Range("G38").Copy
End With
R.Offset(1, 5).PasteSpecial xlPasteValues

End If
End Sub

Je voudrait pouvoir fusionner les cellules qui prècede après la copie des èlèemnt et avant la fermeture du classeur conserné .
J'ai essayer d'apliquer la macro comme ça mais elle ne fonctionne pas .C'est pour cette raison que je ma tourne vers vous .

Vous remerciant toutes et tous part avence de votre aide, je vous dis à plus sur se fil pour toutes infos complèmentaire si je n'avais pas ètè sufisament claire .
br44

 

[Sylvain]

Re : Simplification de macro

Bonsoir,

Quelques idées :

pour la fusion, voici un code qui devrait fusionner chacune des plages d'une sélection multiple :
Sub Fusion(plage As Range)
Dim rge As Range
For Each rge In plage.Areas
rge.Merge
Next
End Sub

tu peux l'appeler en faisant
call Fusion(Range("A12:A13,B12:B13,C12:C13"))

Sinon dans ton codes tu as :

With Wb2.Sheets("Annexfacture1")
.Range("C16").Copy
End With
R.Offset(1, 3).PasteSpecial xlPasteValues

tu peux remplacer par :
R.offset(1,3).value = Wb2.Sheets("Annexfacture1").Range("C16").value

A+

 

[br44]

Re : Simplification de macro

re: Bonsoir Sylvain ,le forum .

Grand merci à toi pour cette macro et aussi pour t'as rapidité.

je vaudrais juste savoir si compris t'as manip , cela me donnerait :

Sub Fusion(plage As Range)
Dim rge As Range
For Each rge In plage.Areas
rge.Merge

call Fusion(Range("A12:A13,B12:B13,C12:C13"))

Next
End Sub
mais je la place ou dans la macro et je place les variables ?

si tu peux me donnèes quelques infos supplèmentaires ça serais chic .
En tout cas merci pour t'as solution est à bientôt sur ce fil ou sur le forum .
BR44

 

[Staple1600]

Re : Simplification de macro

Bonsoir

Public Sub Fusion(plage As Range)
Dim rge As Range
For Each rge In plage.Areas
rge.Merge
Next
End Sub
'Et la tu lances cette macro


Sub Macro_FUSION()
Application.DisplayAlerts = False
Fusion (Sheets(1).Range("A12:A13,B12:B13,C12:C13"))
'adapter le nom de la feuille et la plage de cellules
End Sub

 

[Gorfael]

Re : Simplification de macro

Salut br44 et le forum
Pas tout compris :

If Range ("G3").Value="C16" Then
With Wb2.Sheets("Annexfacture1")
.Range("C16").Copy
R.Offset(1, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(1, 4).PasteSpecial xlPasteValues
.Range("G38").Copy
End With
R.Offset(1, 5).PasteSpecial xlPasteValues

End If

Range("A12:C13").MergeCells = False
Range("A12:C13").MergeCells = true
End Sub

A+

 

[br44]

Re : Simplification de macro

re: Bonsoir Staple 1600, Gorfael,le forum

Merci de vos rèponses a vous deux j'en prend bonnes notes et vous tient au courant de la suites .

merci encore à plus BR44

 

[br44]

Re : Simplification de macro

re: rebonsoir à tous
Gorfael :

je vient de tester te solution et ça marche Youpi !!!!!

juste un petit rapel peut- me donnèe la formule vba pour mettres mes lignes à une hauteures de 23.875
merci d'avances . A PLUS Br44

 

[Gorfael]

Re : Simplification de macro

re: rebonsoir à tous
Gorfael :

je vient de tester te solution et ça marche Youpi !!!!!

juste un petit rapel peut- me donnèe la formule vba pour mettres mes lignes à une hauteures de 23.875
merci d'avances . A PLUS Br44

Salut
comme je ne connais pas tes données :

Rows(1).RowHeight = 23.875
Définit la hauteur de la ligne 1

Range("A2:c5").RowHeight = 23.875
ou
Rows("2:5").RowHeight = 23.875
définit celle des lignes 2 à 5

A+

 

[br44]

Re : Simplification de macro

re: Bonjour le forum ,Bonjour Gorfael

Merci pour cette piqure de rapel et bon courage pour la suite .

A bientôt sur le forum
BR44

 

[br44]

Re : Simplification de macro

re : Rebonsoir A tous

j'ai une petite question annex

je voudrais pouvoir inserer 2 lignes vierges en dessous de ma ligne 16 de mon classeur de destination ,hors actuelement je ne peut en insere q'une seul j'ai essayé plusieur solution mais à chaque fois il mais une erreur 1004 pour le deuxième ,je suposes que cela vient du fait que la ligne prècedent est vierge ?

je mais ma dernière macros teste :

'Dèclare la variable chemin
Dim Chemin As String
'Dèclare les varaibles Wb1 et Wb2
Dim wb1 As Workbook
Dim Wb2 As Workbook
'Dèclare la variable i
Dim i As Long
'Dèclare la variable j
Dim j As Integer

'Dèfinit la variable chemin
Chemin = "C:\RAPID\GESTION\SC.xls"
'Dèfinit les variables Wb1 et Wb2
Set wb1 = Workbooks.Open(Chemin)
Set Wb2 = ThisWorkbook

'j'ouvre le classeur "SC.xls"
wb1.Activate
For i = Range("A65535").End(xlUp).Row To 1 Step -1
If Range("A" & i).Value = "C16" Then
For j = 1 To 2 ' la j'insere 2 ligne
Rows(i + 1).Insert xlDown
Next j
End If
Next i

'J'enregistre la modification dans le classeur" sc.xls"
wb1.Save
'je ferme le classeur "Sc.xls"
wb1.Close
End Sub

A noter : Cette macros se dèclange sur un l'userfrom de la feuille "annexFacture1" d'ou la difference de code .

merci par avance du coup de main et milles excuses pour le dèrangement .
A plus BR44

 

[br44]

Re : Simplification de macro

Re: Bonsoir le forum ,

Ce petit message pour vous signaler que j'ai rèsolu le problème .

L'erreur 1004 ètait situèe dans le classeur de destination est non dans le classeur de dèpart chose que je croyais .

Il y avait des restes d'ècriture dans certaines cellules que je n'avait pas vu .

ce message annule donc l'envoie prècèdant .
Merci à tous pour le coup de main .

A noter: je mets fin à ce fil ,puisque la partie consernè est rèsolu .
Je vous donne rdv sur un nouveau post pour poffiner le program .

A bientôt donc Br44