Supression de ligne en VBA suivant INDEX

Le
rthompson
Bonjour à toutes et tous

Une question un peu plus compliqué cette fois

Dans un fichier de plusieurs feuilles

Feuille "Offers" contient une série d'offre
Elles sont chacune sur une ligne et 50 colonnes

Feuille "Consulte offers" je retrouve l'info d'une offre dans un tableau
Ceci ce fait grâce à vous et la formule

=INDEX(INDIRECT("Offers!D4:D3015");$A$2)

Sur cette feuille un bouton associé à une macro qui fait un peu de tout

Ce que je voudrais c'est que la ligne référée en $A$2 soit couper
et coller sur une ligne insérée sur une feuille "Accepted Offers"

Ci-dessous la macro tel quelle est maintenant

J'espère avoie été assez clair et que les Excelgénies vont encore frapper

A bientôt

Rex

Macro créée grâce à vous, bien entendu

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Sub Enregistrer_Commande()

If MsgBox("Enregistrer la Commande?", vbYesNo, "OUI") = vbYes Then


m_s = ActiveSheet.Name
m_c = ActiveCell.Address

' Inserts a new row on top of the list

Application.ScreenUpdating = False
Sheets("Orders").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert

' Copies all the customers info to the Orders sheet

' Date
Sheets("Consult_Offers").Range("F4").Copy
Sheets("Orders").Range("a4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse

''''' ici j'ai coupé une série de ligne répetitive
'''' qui ne serve à rien pour votre réponse


' copying products, prices, quantities and totals

' Copies info from Consult_Offers to Orders in a "One row" format

Sheets("Consult_Offers").Select
For Each c In Worksheets("Consult_Offers").Range([C13], [C53].End(xlUp))
Sheets("Orders").Select
For Each d In Worksheets("Orders").Range([a1], [EA1].End(xlToLeft))
If d = c Then
d.Offset(3, 0).Select
Range(c.Offset(0, 1), c.Offset(0, 3)).Copy
Selection.Pastespecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

d.Offset(3, 3).Select
c.Offset(0, 7).Copy
Selection.Pastespecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

End If
Next
Next

' copies Commentaires to Orders
Sheets("Consult_Offers").Range("c56").Copy
Sheets("Orders").Range("EE4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse

' Copies PROFIT from j48 to ds4
Sheets("Consult_Offers").Range("I53").Copy
Sheets("Orders").Range("EB4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse



Sheets(m_s).Select
Range(m_c).Select

Application.ScreenUpdating = True

' this prints to PDF file not used for now

' Application.ActivePrinter = "CutePDF Writer on CPW2:"
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
' "CutePDF Writer on CPW2:", Collate:=True
End If

End Sub
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
rthompson
Le #4624321
Et tant que j'y suis

Par la même occasion peut-on ajouter sur la feuille "Offers" une info sur la
ligne référencier en $A$2???

Encore merci et à bientôt

Rex


"rthompson" news:
Bonjour à toutes et tous

Une question un peu plus compliqué cette fois

Dans un fichier de plusieurs feuilles

Feuille "Offers" contient une série d'offre
Elles sont chacune sur une ligne et 50 colonnes

Feuille "Consulte offers" je retrouve l'info d'une offre dans un tableau
Ceci ce fait grâce à vous et la formule

=INDEX(INDIRECT("Offers!D4:D3015");$A$2)

Sur cette feuille un bouton associé à une macro qui fait un peu de tout

Ce que je voudrais c'est que la ligne référée en $A$2 soit couper
et coller sur une ligne insérée sur une feuille "Accepted Offers"

Ci-dessous la macro tel quelle est maintenant

J'espère avoie été assez clair et que les Excelgénies vont encore frapper

A bientôt

Rex

Macro créée grâce à vous, bien entendu

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Sub Enregistrer_Commande()

If MsgBox("Enregistrer la Commande?", vbYesNo, "OUI") = vbYes Then


m_s = ActiveSheet.Name
m_c = ActiveCell.Address

' Inserts a new row on top of the list

Application.ScreenUpdating = False
Sheets("Orders").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.EntireRow.Insert

' Copies all the customers info to the Orders sheet

' Date
Sheets("Consult_Offers").Range("F4").Copy
Sheets("Orders").Range("a4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse

''''' ici j'ai coupé une série de ligne répetitive
'''' qui ne serve à rien pour votre réponse


' copying products, prices, quantities and totals

' Copies info from Consult_Offers to Orders in a "One row" format

Sheets("Consult_Offers").Select
For Each c In Worksheets("Consult_Offers").Range([C13],
[C53].End(xlUp))
Sheets("Orders").Select
For Each d In Worksheets("Orders").Range([a1], [EA1].End(xlToLeft))
If d = c Then
d.Offset(3, 0).Select
Range(c.Offset(0, 1), c.Offset(0, 3)).Copy
Selection.Pastespecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

d.Offset(3, 3).Select
c.Offset(0, 7).Copy
Selection.Pastespecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

End If
Next
Next

' copies Commentaires to Orders
Sheets("Consult_Offers").Range("c56").Copy
Sheets("Orders").Range("EE4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse

' Copies PROFIT from j48 to ds4
Sheets("Consult_Offers").Range("I53").Copy
Sheets("Orders").Range("EB4").Pastespecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:úlse, Transpose:úlse



Sheets(m_s).Select
Range(m_c).Select

Application.ScreenUpdating = True

' this prints to PDF file not used for now

' Application.ActivePrinter = "CutePDF Writer on CPW2:"
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
' "CutePDF Writer on CPW2:", Collate:=True
End If

End Sub








Publicité
Poster une réponse
Anonyme