Inserer à partir d'une cellule

Bonjour et bonne année à tous,

Je suis actuellement sur un code dont la fonction est la suivante :

Je dispose de deux fichiers avec dans chacun de leurs onglet une colonne avec le même type de donnée. Mon code va comparer les données de la colonne du fichier 1 avec celles du fichier 2 afin d'insérer une ligne, chaque fois que donnée2=donnée1, dans le fichier 1.

Voici mon code :

Sub Macro1()

Dim Fichier As String
Dim donnees1 As Range
Dim donnees2 As Range
Dim Elm As Object
Dim Cellu As Object

Application.ScreenUpdating = False
With ThisWorkbook.Sheets("classeur1test")

Fichier = "C:\Users\Desktop\Travaux\classeur2test.xlsx"
Workbooks.Open Filename:= _
            Fichier
Set donnees1 = .Range("M20:M385") 'Je sens qu'il y a un problème également à ce niveau
Set donnees2 = Sheets("Feuil1").Range("B1:B365") 
For Each Cellu In Nom1
For Each Elm In Nom2
If Elm.Value = Cellu.Value Then

'Je ne sais pas quoi mettre pour insérer à partir de la ligne+1 de Cellu

End If
Next Elm
Next Cellu

End With

End Sub

J'ai deux problèmes :

1) Je ne sais pas comment faire ce que je vous ai expliqué

2) La comparaison est incroyablement lente quand je lance uniquement cette partie , il y a t'il un moyen de l'optimiser ?

Bonjour,

Tu travailles avec Excel 2016.

Tu as donc la possibilité de travailler avec Récupérer et transformer des données (Power Query). Et l'opportunité de te passer de VBA.

Dans tous les cas, joins 2 fichiers pour nous permettre de t'apporter une aide adaptée.

Tu en profiteras pour nous expliquer le besoin d'insérer des lignes vides !...

Cdlt.

Bonjour le fil, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim CS As Workbook
Dim OS As Worksheet
Dim CC As Workbook
Dim OC As Worksheet
Dim TVS As Variant
Dim TVC As Variant

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.Worksheets("classeur1test")

Set CC = Workbooks.Open("C:\Users\Desktop\Travaux\classeur2test.xlsx")
Set OC = CC.Worksheets("Feuil1")
For I = 385 To 21 Step -1
    If OS.Cells(I, "M").Value = OC.Cells(I - 20, "B").Value Then OS.Rows(I + 1).Insert
Next I
End Sub

Tout d'abord merci pour vos réponses.

Bonjour,

Tu travailles avec Excel 2016.

Tu as donc la possibilité de travailler avec Récupérer et transformer des données (Power Query). Et l'opportunité de te passer de VBA.

Dans tous les cas, joins 2 fichiers pour nous permettre de t'apporter une aide adaptée.

Tu en profiteras pour nous expliquer le besoin d'insérer des lignes vides !...

Cdlt.

Je vais me renseigner sur Power Query merci beaucoup. Je ne peux malheureusement pas transmettre les fichiers car ils contiennent des données confidentielles et sont beaucoup trop longs à anonymiser, j'ai donc fait des fichiers les resemblant grossièrement que j'attacherai à ce message.

Le but de la manoeuvre est de coller des données dans ces lignes vides par la suite. Le fichier Test1 contient les previsions pour chaque personnes sur l'année et le fichier Test2 ce qui a vraiment été fait sur le mois. Il s'agit d'insérer une ligne chaque fois que la prévision du mois donné (Janvier 2019 par exemple) est différent du réalisé et de coller le réalisé juste en dessous de la prévision. Ici j'ai mis les mêmes prénoms en colonne mais il y a souvent des prenoms qu'on trouve dans une liste et pas dans l'autre et vice versa.

3test2.xlsx (9.14 Ko)
3test1.xlsx (10.59 Ko)

Merci ThauThème pour ton code, j'ai essayé mais apparement celui-ci ne prend pas en compte le fait que la donnée qu'il compare se trouve peut être plus haut dans la colonne.

Désolé j'ai oublié de nommer les onglets

Rebonjour à tous, j'ai trouvé une solution qui fontionne mais j'ai un problème, la macro ne traite pas toutes les données, elle le fait pour les 350 premières par exemple et s'arrête net sans toucher le reste. À l'échelle du fichier Test1 que je vais joindre, il n'y a que la première donnée qui est traitée. Comment remédier à ce problème s'il vous plait.

Voici le code :

Sub Macro1()

Dim Fichier As String
Dim Nom As Range
Dim Nom2 As Range
Dim Elm As Object
Dim Cellu As Object

Application.ScreenUpdating = False
With ThisWorkbook.Sheets("HAZE")

Fichier = "C:\Users\Moi\Desktop\Test2.xlsx"
Workbooks.Open Filename:= _
            Fichier
t = Range("M1", [M100000].End(xlUp)).Count 'Car le range grandi au fur et à mesure de l'execution vu qu'on insère des lignes
Set Nom = .Range("M20", "M" & t)
Set Nom2 = Sheets("PURPLE").Range("B2", [B100000].End(xlUp)) 'taille de la colonne est variable
For Each Cellu In Nom
For Each Elm In Nom2
If Elm.Value = Cellu.Value Then

Cellu.Offset(1, 0).EntireRow.Insert

End If
Next Elm
Next Cellu

End With

End Sub
2test2.xlsx (9.28 Ko)
3test1.xlsm (18.73 Ko)
Rechercher des sujets similaires à "inserer partir"