aide pour macro

[bpol]

bonsoir,

voici une macro qui me convient mais je voudrais qu'elle ne copie pas le format ni la mise en forme conditionnelle de la base de données.
et ne prendre que les 2 premières colonnes de la BD.
Comment puis la modifier?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellRecherche As Range, premAdresse As String

'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

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"
cellRecherche.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(1)
'chercher la cellule suivante
Set cellRecherche = .Columns("A").FindNext(cellRecherche)
Loop Until cellRecherche.Address = premAdresse
End With
End Sub


Merci
Bpol

 

[bpol]

Re : aide pour macro

re,
aurais je poser une colle ?

 

[jp14]

Re : aide pour macro

Bonsoir

Le code ci dessous permet de limiter aux deux premières colonnes

dl1 = Sheets(Target.Worksheet.Name).Range("b65536").End(xlUp).Row

If Not Intersect(Target, Range("a1:b" & dl1)) Is Nothing Then

......corps de la procédure

end if

JP

 

[bpol]

Re : aide pour macro

bonsoir jp14,

voici un exemple:


http://cjoint.com/?mgug7UMmBe


Merci
BPOL

 

[Modeste]

Re : aide pour macro

Bonsoir à Liège, salut jp14,

Visiblement pas compris (du tout !) la même chose que jp14 😕😕
Je dépose quand même ... on ne sait jamais !

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellRecherche As Range, premAdresse As String
[COLOR="red"]Dim cd As Worksheet[/COLOR]
'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
[COLOR="Red"]Set cd = Worksheets("recherche cd")[/COLOR]
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
[COLOR="red"]cd.Range("A" & cd.Range("A65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues[/COLOR]
'chercher la cellule suivante
Set cellRecherche = .Columns("A").FindNext(cellRecherche)
Loop Until cellRecherche.Address = premAdresse
End With
End Sub

 

[bpol]

Re : aide pour macro

Bonsoir modeste,

merci pour le coup de main
c'est ce que je désirais

Bonne Soirée

BPOL