VBA-Excel : Inserer des lignes sous conditions

Version imprimable

Bonjour,

J'ai besoin de vos lumières.

Colonne A Colonne B Colonne C

A000400v0 A Appels d'offres

G000441 G Matière Premières GR

G000454 G Matière Premières GR

G000467 G Matière Premières GR

G000468 G Matière Premières GR

G000701 G Matière Premières GR

G000705 G Matière Premières GR

G000706 G Matière Premières GR

G000710 G Matière Premières GR

A000405v0 G Appels d'offres

G000657 A Matière Premières GR

G000659 G Matière Premières GR

A000406v0 G Appels d'offres

G000708 A Matière Premières GR

G000729 G Matière Premières GR

J'ai le tableau ci-dessus, je veux créer une macro qui dit que dès que j'ai la lettre A (en colonne B), j'insère 2 lignes au dessus.
La première ligne insérée doit contenir ".<WINPDMIMPORT><LANGUAGE:FRA><VW>vwd_VW_RFQ_TENDER" la deuxième ligne insérée doit contenir :
en colonne A :"vwd_VW_RFQ_REQUIREMENT"
en colonne B: "DESCRIPTION"
en colonne C : "COMMENTS"

Pouvez-vous m'aider SVP.

Merci

Colonne A	Colonne B	Colonne C
A000400v0	A	Appels d'offres
G000441	G	Matière Premières GR
G000454	G	Matière Premières GR
G000467	G	Matière Premières GR
G000468	G	Matière Premières GR
G000701	G	Matière Premières GR
G000705	G	Matière Premières GR
G000706	G	Matière Premières GR
G000710	G	Matière Premières GR
A000405v0	G	Appels d'offres
G000657	A	Matière Premières GR
G000659	G	Matière Premières GR
A000406v0	G	Appels d'offres
G000708	A	Matière Premières GR
G000729	G	Matière Premières GR

Bonjour
Ta demande n'est pas claire au moins pour moi ... et ma réponse suppose que tu cherche à insérer deux lignes en dessus si la colonne B égal à "A"
et puis tu rempli ces deux lignes insérées
Une proposition bricolée par un débutant :aie:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub test()
Dim dernligne As Long
Dim j As Integer
Dim k As Integer
 
'************************************** insérer 2 lignes au dessus ci colonne B égal à "A"
With Sheets("feuil1") ' à adapter sii nécessaire
dernligne = .Range("A" & Rows.Count).End(xlUp).Row
For k = dernligne To 1 Step -1
   If .Cells(k, 2).Value = "A" Then 'égal A et non pas contenir un A si non voir avec LIKE
   Rows(k).Resize(2).Insert
   End If
  Next k
'*************************************remplir première ligne vide insérée *********************************
  For j = 2 To dernligne
  If .Cells(j, 1) = "" And Cells(j + 1, 1) = "" Then
  .Cells(j, 1) = "<WINPDMIMPORT>"
  .Cells(j, 2) = "<LANGUAGE:FRA>"
  .Cells(j, 3) = "<VW>vwd_VW_RFQ_TENDER>"
  End If
  Next j
'*************************************remplir deuxième ligne vide insérée*********************************
  For j = 2 To dernligne
  If .Cells(j, 1) = "" And Cells(j + 1, 1) <> "" Then
  .Cells(j, 1) = "vwd_VW_RFQ_REQUIREMENT"
  .Cells(j, 2) = "DESCRIPTION"
  .Cells(j, 3) = "COMMENTS"
  End If
  Next j
End With
End Sub

17/05/2018, 14h37
cmabon

Merci beaucoup c'est exactement ce que je vouais.
J'ai réussi à adapter ta macro à mon fichier et ça fonctionne.
Mille mercis:D
17/05/2018, 14h47
BENNASR

Merci de cliquer sur résolu