aide sur modification macro

[bpol]

Bonjour le Forum,
tout d'abord mes meilleurs voeux pour l'année nouvelle.
Bon voici mon problème,

j'ai cette macro
Dim NomFeuille As String
Dim Ligne As Integer

'Récupération du nome de la nouvelle feuille
NomFeuille = Range("E2")

'Teste si elle existe déjà.
If FeuilleExiste(NomFeuille) Then
'Si oui, demander s'il faut la remplacer
If MsgBox("La feuille '" & NomFeuille & "' existe déjà!" & vbCrLf & _
"voulez-vous la remplacer?", vbQuestion + vbYesNo, "Créer") = vbYes Then
'Si oui on la détruit
Application.DisplayAlerts = False
Sheets(NomFeuille).Delete
Application.DisplayAlerts = True
Else
'Si non on sort
GoTo FinCreation
End If
End If

Sheets("fiche").Copy After:=Worksheets(Sheets.Count)

ActiveSheet.Name = NomFeuille

'Décommenter la ligne suivante si l'on veut supprimer les boutons de la nouvelle feuille
'SupprimerObjets nomfeuille

'Décommenter la ligne suivant si l'on veut ôter la validation de
'ActiveSheet.Range("H9").Validation.Delete

With Sheets("liste")
Ligne = .Range("A65536").End(xlUp).Row + 1

.Hyperlinks.Add Anchor:=.Cells(Ligne, 1), _
Address:="", _
SubAddress:="'" & NomFeuille & "'!A1", _
TextToDisplay:=NomFeuille

.Cells(Ligne, 2) = Sheets("fiche").Range("E4")
'And
With Sheets("BD")
Ligne = .Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("fiche").Range("E2")
Cells(Ligne, 2) = Sheets("fiche").Range("E4")
Cells(Ligne, 3) = Sheets("fiche").Range("E5")
Cells(Ligne, 4) = Sheets("fiche").Range("E7")
Cells(Ligne, 5) = Sheets("fiche").Range("E8") End With

Worksheets("fiche").Select

FinCreation:
End With
End Sub

1 pourquoi la partie en gras ne fonctionne pas?
2 comment faire pour ajouter une instuction en fin de macro pour sélectionner une série de cellulles ?( j'ai essayer plusieurs manières et cela bug à chaque fois)

Si on pouvait me donner la syntaxe pour m'aider à continuer se serait sympa.
Merci
BPOL

 

[bpol]

Re : aide sur modification macro

Bonsoir Jean-Marcel,

non l'adresse sera sous la forme:
rue Aaaaa 4

Merci
Bpol

 

[bpol]

Re : aide sur modification macro

Re,
oui c'est bien cela mais j'ai déjà vu cela sans bouton cela se faisait dès que l'on rempli le critère
déclaration dans thisworkbook je crois.

Bpol

 

[bpol]

Re : aide sur modification macro

Bonjour,

Merci pour tout

Bpol

 

[bpol]

Re : aide sur modification macro

RE,
jai retrouvé la macro que j'aurai voulu modifier pour la mettre en déclaration de la feuille "liste"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellRecherche As Range, premAdresse As String
Dim cd As Worksheet
'si ce n'est pas la cellule B1 qui vient du changer, quitter la macro
If Not Target(1, 1).Address = "$B$1" Then Exit Sub

'nettoyer la zone d'affichage de la racherche
Range(Range("A4"), Range("A4").End(xlDown)).Resize(, 4).ClearContents

'si la cellule est vide, quitter la macro
If Target.Text = vbNullString Then Exit Sub
Set cd = Worksheets("recherche cd")
With ThisWorkbook.Sheets("vidéothèque")
'lancer la recherche
Set cellRecherche = .Columns("A").Find(Target.Text, , xlValues, xlWhole, , , False)
'si rien n'est trouvé, quitter la macro
If cellRecherche Is Nothing Then Exit Sub
premAdresse = cellRecherche.Address
Do
'copier la ligne dans "recherche CD"
.Range(cellRecherche, cellRecherche.Offset(, 1)).Copy
cd.Range("A" & cd.Range("A65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
'chercher la cellule suivante
Set cellRecherche = .Columns("A").FindNext(cellRecherche)
Loop Until cellRecherche.Address = premAdresse
End With
End Sub

mais je ne la comprend pas!

Merci
BPOL

 

[bpol]

Re : aide sur modification macro

RE un petit UP,

re voici ma question avec le fichier.

c'est cette macro que je désirerais modifier


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellRecherche As Range, premAdresse As String
Dim cd As Worksheet
'si ce n'est pas la cellule B1 qui vient du changer, quitter la macro
If Not Target(1, 1).Address = "$B$1" Then Exit Sub

'nettoyer la zone d'affichage de la racherche
Range(Range("A4"), Range("A4").End(xlDown)).Resize(, 4).ClearContents

'si la cellule est vide, quitter la macro
If Target.Text = vbNullString Then Exit Sub
Set cd = Worksheets("recherche cd")
With ThisWorkbook.Sheets("vidéothèque")
'lancer la recherche
Set cellRecherche = .Columns("A").Find(Target.Text, , xlValues, xlWhole, , , False)
'si rien n'est trouvé, quitter la macro
If cellRecherche Is Nothing Then Exit Sub
premAdresse = cellRecherche.Address
Do
'copier la ligne dans "recherche CD"
.Range(cellRecherche, cellRecherche.Offset(, 1)).Copy
cd.Range("A" & cd.Range("A65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
'chercher la cellule suivante
Set cellRecherche = .Columns("A").FindNext(cellRecherche)
Loop Until cellRecherche.Address = premAdresse
End With
End Sub

BPOL