Copier et insérer des lignes en fonction du contenu de certaines cellules

johannnorell

XLDnaute Nouveau
Bonjour,

Je suis débutant niveau 0 en macro et j'aurai donc besoin de votre immense magie.

Le problème:

J'ai un fichier Excel de 4000 lignes et une petite centaine de colonnes. Il s'agit d'une liste de dossier avec dates d'ouverture de fouilles. Sachant que pour chaque dossier il peut y avoir jusqu'à 4 fouilles, l'idée serait de checker s'il existe une date d'ouverture pour les fouilles #2, 3 et 4; et à chaque fois copier la ligne entiere et l'insérer en dessous de la ligne #1.

En bref:

(Fouille#2) Si AJx <> "" insérer ligne x en x+1 sinon next x (il peut pas y avoir de fouille 3 sans fouille 2)
(Fouille #3) Si AVx <> "" insérer ligne x en x+2 ...

Le truc c'est que la boucle devra tester les 3 conditions successivement, les dimensions du tableau deviennent dynamiques et on peut avoir à insérer selon les cas 1, 2 ou 3 lignes. Bref c'est trop compliqué pour moi.

S'il y a une âme charitable qui pourrait m'aider je militerai personnellement pour que son nom soit rajouté sur la tour Eiffel.

Merci d'avance!
 

Pièces jointes

  • Export.xlsx
    291.6 KB · Affichages: 48
  • Export.xlsx
    291.6 KB · Affichages: 44
  • Export.xlsx
    291.6 KB · Affichages: 50

Paf

XLDnaute Barbatruc
Re : Copier et insérer des lignes en fonction du contenu de certaines cellules

bonjour,

Le principe semble simple, ( une boucle sur l'ensemble des lignes contenant une boucle testant les cellules AJx, AVx et BHx)
Deux questions avant d'appronfondir:
-si ces cellules sont renseignées, faut il rajouter en x+1 l'ensemble de la ligne ou simplement les données de la fouille en question sous les données de la fouille 1 ?
-Parfois les cellules AJx, AVx et BHx sont renseignées sans que la cellule précédente (Date_Programme_Ouverture_Fouille_y) le soient, ou inversement les cellules Date_Programme_Ouverture_Fouille_y sont renseignées et les cellules AJ,AV ou BH sont vides.
Y a-t-il une règle particulière pour ces cas ou faut-il simplement copier si AJ,AV ou BH sont remplies.

A+

Edit : Et bienvenu sur XLD
 
Dernière édition:

johannnorell

XLDnaute Nouveau
Re : Copier et insérer des lignes en fonction du contenu de certaines cellules

Merci pour ta réponse Paf!

Pour répondre à tes questions:

- Si ces cellules sont renseignées, il faut copier l'ensemble de la ligne x en dessous.
- Ce qui compte c'est la date d'ouverture (Date_Realise_Ouverture), parce que ça signifie qu'il y a une fouille effectivement ouverte. La cellule d'avant, c'est la date à laquelle l'ouverture est programmée, mais c'est à titre indicatif et il peut arriver que l'ouverture soit programmée et jamais réalisée ou alors qu'un charmant collègue oublie par pure mégarde de renseigner la date programmée. Bref, ce qui m'intéresse c'est bien Date_Realise_Ouverture.

Merci encore!!!
 

Paf

XLDnaute Barbatruc
Re : Copier et insérer des lignes en fonction du contenu de certaines cellules

Re,

le code ci dessous devrait faire l'affaire
Code:
Sub johannnorell()
Dim DerL As Integer, i As Integer, j As Byte
DerL = Range("A" & Rows.Count).End(xlUp).Row 
Application.ScreenUpdating = False
For i = DerL To 3 Step -1
    For j = 36 To 60 Step 12
        If Cells(i, j) <> "" Then
                Rows(i).Copy
                Rows(i).Insert Shift:=xlDown
        End If
    Next
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

A+
 

johannnorell

XLDnaute Nouveau
Re : Copier et insérer des lignes en fonction du contenu de certaines cellules

Rebonjour,

J'ai une petite variante au problème. Est-ce qu'il y aurait moyen de déplacer le contenu des cellules correspondant aux fouilles 2, 3 et 4 à chaque fois dans la partie réservée à la fouille 1 dans les nouvelles lignes?

J'explique: si AJx <> "" on copie la ligne x et on l'insère en dessous. Par contre je voudrais que les données des 12 cellules correspondant à la fouille 2 (AIx+1:ATx+1) soient déplacées dans les 12 cellules de la fouille 1 (Wx+1:AHx+1). Idem pour les fouilles 3 et 4 qui vont à chaque fois dans les cellules de la fouille 1 sur la ligne insérée.

Merci beaucoup par avance!
 

Paf

XLDnaute Barbatruc
Re : Copier et insérer des lignes en fonction du contenu de certaines cellules

Re,

remplacer le code
Code:
        If Cells(i, j) <> "" Then
                Rows(i).Copy
                Rows(i).Insert Shift:=xlDown
        End If
par
Code:
        If Cells(i, j) <> "" Then
                Rows(i + 1).Insert Shift:=xlDown
                Range(Cells(i, 1), Cells(i, 22)).Copy Range("A" & i + 1)
                Range(Cells(i, j - 1), Cells(i, j + 10)).Copy Range("W" & i + 1)
        End If

Je crains que "PAF PAF" fasse mauvais effet sur la tour Eiffel !!

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 103
Messages
2 085 325
Membres
102 862
dernier inscrit
Emma35400