Recherche Copier coller
Bonjour les amis j'espère que vous allez bien ?
Grace a votre aide j'ai pu écrire une macro qui me permet de faire une recherche v en boucle et de copier les résultats de cette recherche sur un autre onglet.
Mon problème dans ce code est que quand ma boucle tombe sur une céllule vide il ne prends pas en compte le fait que " le vide " de cette cellule soit une valeur mais copie colle la valeur qui est juste en dessous de la cellule vide.
Je vous joins mon fichier et mon code.
Je vous remercie d'avance pour votre aide.
Sub recherche() ' Matrice permettant de chercher les information
Application.ScreenUpdating = False
Dim WS1 As Worksheet
Dim Ws2 As Worksheet
Dim Trv
Set WS1 = Sheets("Base de données")
Set Ws2 = Sheets("Recherche")
Ws2.Range("A1").Value = UCase(Ws2.Range("A1"))
Ws2.Select
Set Trv = [A1]
Ws2.Range("A4:M" & Range("A65535").End(xlUp).Row + 1).ClearContents
For Each cellule In Sheets("Base de données").Range("B2:B" & Sheets("Base de données").Range("B65535").End(xlUp).Row)
If UCase(cellule) = Trv Then
Range("A" & Range("A65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 1)
Range("B" & Range("B65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 3)
Range("C" & Range("C65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 4)
Range("D" & Range("D65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 5)
Range("E" & Range("E65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 6)
Range("F" & Range("F65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 7)
Range("J" & Range("J65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 11)
Range("K" & Range("K65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 12)
Range("L" & Range("L65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 13)
Range("M" & Range("M65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 14)
Range("N" & Range("N65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 15)
End If
Next cellule
End SubBonjour,
pour remédier , une solution est :
remplacer
Range("B" & Range("B65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 3)
par
Range("B" & Range("B65535").End(xlUp).Row + 1) = IIf(IsEmpty(WS1.Cells(cellule.Row, 3)), "rien", WS1.Cells(cellule.Row, 3))
si la cellule est vide dans base de données, on écrit "rien", si occupée on ramène le contenu
ton erreur est que si qq chose en colonne A il écrit dans la dernière cellule libre de A mais si rien il ne mets rien , donc au tout suivant il ira écrire là où c'est vide... c'est que tu lui dis avec "Range("B" & Range("B65535").End(xlUp).Row + 1)"
P.
Bonsoir à tous,
C'est la même question que ton précédent post
Option Compare Text
Sub Copy()
Dim a, b(), i As Long, j As Long, n As Long
With Sheets("Base de données").Range("A1").CurrentRegion
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(1, 2, 3, 5, 6, 7, 11, 12, 13, 14, 15))
End With
ReDim b(1 To UBound(a, 1), 1 To 11)
For i = 2 To UBound(a, 1)
If a(i, 2) = Sheets("Recherche").Range("A1").Value Then
n = n + 1
For j = 1 To UBound(a, 2)
b(n, j) = a(i, j)
Next
End If
Next
If n > 0 Then
Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)) = b
Else
MsgBox "Aucune donnée"
End If
End Subklin89
Klin89 a écrit :Bonsoir à tous,
C'est la même question que ton précédent post
Option Compare Text Sub Copy() Dim a, b(), i As Long, j As Long, n As Long With Sheets("Base de données").Range("A1").CurrentRegion a = Application.Index(.Value, Evaluate("row(1:" & _ .Rows.Count & ")"), Array(1, 2, 3, 5, 6, 7, 11, 12, 13, 14, 15)) End With ReDim b(1 To UBound(a, 1), 1 To 11) For i = 2 To UBound(a, 1) If a(i, 2) = Sheets("Recherche").Range("A1").Value Then n = n + 1 For j = 1 To UBound(a, 2) b(n, j) = a(i, j) Next End If Next If n > 0 Then Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)) = b Else MsgBox "Aucune donnée" End If End Subklin89
Meci Klin89 pour ton code il fonctionne mais pour certaines dates il m'inverse le mois et le jour pour le copier coller.
patrick1957 a écrit :Bonjour,
pour remédier , une solution est :
remplacer
Range("B" & Range("B65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 3)
par
Range("B" & Range("B65535").End(xlUp).Row + 1) = IIf(IsEmpty(WS1.Cells(cellule.Row, 3)), "rien", WS1.Cells(cellule.Row, 3))
si la cellule est vide dans base de données, on écrit "rien", si occupée on ramène le contenu
ton erreur est que si qq chose en colonne A il écrit dans la dernière cellule libre de A mais si rien il ne mets rien , donc au tout suivant il ira écrire là où c'est vide... c'est que tu lui dis avec "Range("B" & Range("B65535").End(xlUp).Row + 1)"
P.
aaah je te remercie Patrick1957 je vais utiliser cette méthode alors !
Re PetitPrince,
Remplace cette ligne :
Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)) = bpar celle-ci
Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)).FormulaLocal = bklin89
Klin89 a écrit :Re PetitPrince,
Remplace cette ligne :
Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)) = bpar celle-ci
Sheets("Recherche").Range("A4").Resize(n, UBound(b, 2)).FormulaLocal = bklin89
Merci beaucoup