Creer une feuille a partir du nom d'une cellule...

[sams90]

Bonjour,
Etant débutant en VBA, je galère un peu à écrire cette macro.
je vous soumets mon problème.
J'ai un fichier qui comprend deux feuilles : "DR" et "Contrats"

La feuille "Contrats" comprend 4 colonnes.
la feuille "Région" comprend deux colonnes "Directions Régionales" et "CGR".

Je souhaiterais écrire une macro qui recherche pour chaque cellule, les valeurs de la colonne "CGR" de la feuille "Région" dans la colonne "Code" de la feuille "Contrats".

Pour chaque cellule de "CGR" trouvée, copier la ligne correspondante dans la feuille "Contrats" puis la coller dans une nouvelle feuille qui sera créée automatiquement et nommée avec la cellule correspondante dans la colonne "Directions Régionales" de la feuille "Région"


je vous remercie pour votre aide.

 

[sams90]

Re : Creer une feuille a partir du nom d'une cellule...

J'ai commencé à écrire un code mais j'arrive pas à copier coller...


Sub creer_feuilles_DR()

Dim Direction_Regionale As String
Dim i, j
Dim Derlign As Long, Derlig As Long, Derligne As Long
Dim Code_DR1 As String
Dim Code_DR2 As String
Dim n As Integer
Dim feuille_trouve As Boolean
Dim Nom_feuille As String

'stop rafraichissement ecran
Application.ScreenUpdating = False
'ceci va chercher le numéro de la dernière ligne de la colonne b de la feuille "Region"
Derlign = Sheets("Region").Range("B" & Rows.Count).End(xlDown).Row
'ceci va chercher le numéro de la dernière ligne de la colonne d de la feuille "Contrats"
Derlig = Sheets("Contrats").Range("D" & Rows.Count).End(xlUp).Row


'CGR à rechercher dans la colonne D de la feuille Contrats
For i = 2 To Derlign
Nom_feuille = Sheets("Region").Range("A" & i).Value
Code_DR1 = Sheets("Region").Range("B" & i).Value
For j = 2 To Derlig
Code_DR2 = Sheets("Contrats").Range("D" & j).Value
If Code_DR1 = Code_DR2 Then
For n = 1 To Sheets.Count
If Sheets(n).Name = Sheets("Region").Range("A" & i).Value Then
feuille_trouve = True
Exit For
End If
Next n
If Not feuille_trouve Then
Sheets.Add.Name = Nom_feuille
End If
'copy ligne entiere

Sheets("contrats EDF").Range("B" & j).EntireRow.Copy Sheets("Nom_feuille").Range("A" & Derligne + 1)

End If
Next j
Next i

End Sub

 

[titiborregan5]

Re : Creer une feuille a partir du nom d'une cellule...

Bonjour Sams et bienvenue ici, bonjour le forum,

comment on fait si plusieurs lignes correspondent?

voici un bout de code qui marche chez moi, et si j'ai bien compris la demande! (+PJ)

Sub titiborregan5()A = Sheets("Region").Range("B1").End(xlDown).Row


With Sheets("region")
For i = 2 To A


a_chercher = .Cells(i, 2)
P = Application.Match(a_chercher, Sheets("Contrats").Range("D:D"), 0)


If IsNumeric(P) Then
'MsgBox a_chercher & " trouvé en ligne " & P
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = a_chercher
Sheets("Contrats").Range("A" & P & ":D" & P).Copy Sheets(Sheets.Count).Range("A1")
Sheets(Sheets.Count).Columns.AutoFit
Else
'MsgBox a_chercher & " non trouvé!"
End If


Next
End With
End Sub

 

[sams90]

Re : Creer une feuille a partir du nom d'une cellule...

Merci à toi titiboregan5,
C'est exactement le résultat que je veux avoir.
Effectivement s'il y a plusieurs lignes correspondant il faudra copier et coller toutes ces lignes dans la feuille créée.
Aurais-tu une proposition de code ?

merci d'avance