Problème avec l'utilisation de la fonction find

Bonjour tout le monde.

Je suis débutant en VBA, actuellement je travaille sur un fichier qui permettera de gérer des pmp (plans de maintenance préventive).

Dans la feuille "calcul2" je fait des tries qui me permet de sortir les informations voulue dans les colonnes "I:O"

je veut copié cet information dans la feuille "Home" en "BE:BK" en retirant les trop entre chaque ligne d'information.

j'ai donc essayer de réaliser cette action en VBA, mon problème actuellement est que la fonction find que j'utilise me donne des cellules n'importe comment.

merci d'avance pour votre réponse 😋

Sub PMPfait2()

Dim PMP As String
Dim PMPad As String
Dim PMPad2 As String
Dim ligne As Long
Dim plus As Long
Dim cel As Range
Sheets("calcul2").Activate
PMP = Range("h1").Value

If PMP = 0 Then
Sheets("HOME").Activate

Range("bh").Value = "pas de pmp"

plus = 0
Else
PMP = PMP
For i = 1 To PMP
plus = plus + 1
Sheets("calcul2").Activate
Range("G1") = plus
Range("h2:h1000").Select
Set PMP1 = Range("h2:h1000").Find(Range("g1").Value)

Range(PMP1.Address).Select

ActiveCell.Offset(0, 1).Select
PMPad = ActiveCell.Address
ActiveCell.Offset(0, 6).Select
PMPad2 = ActiveCell.Address

Range(PMPad & ":" & PMPad2).Select
Selection.Copy
Sheets("HOME").Activate
ligne = Sheets("HOME").Range("BE29:B999999").End(xlUp).Row + 1
Range("Be" & ligne).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Next
End If

End Sub

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour,

Un essai, si j'ai bien compris ....

Sub PMPfait2()

Dim PMP As String, PMP1
Dim PMPad As String
Dim PMPad2 As String
Dim ligne As Long
Dim plus As Long
Dim cel As Range

PMP = Sheets("calcul2").Range("h1").Value

If PMP = 0 Then
    Sheets("HOME").Activate
    Range("bh").Value = "pas de pmp"
    plus = 0
Else
Sheets("calcul2").Activate
For i = 1 To PMP
plus = plus + 1

Range("G1") = plus
Range("h2:h1000").Select
PMP1 = Range("h2:h1000").Find(Range("g1").Value, LookIn:=xlValues).Address

PMPad = Range(PMP1).Offset(0, 1).Address
PMPad2 = Range(PMP1).Offset(0, 6).Address

ligne = Sheets("HOME").Range("BE99999").End(xlUp).Row + 1
Sheets("HOME").Range("BE" & ligne & ":BK" & ligne).Value = Range(PMPad & ":" & PMPad2).Value
Next
End If
Sheets("Home").activate
End Sub

Edit : Mince, 3 plombes pour sortir un truc vachement moins bien que gmb .... Je les aurai un jour ces tableaux, je les aurai !

Merci a vous Gmb et JoyeuxNoël.

gmb ton code fonctionne est-ce que tu pourrais m'expliquer ?

et ton code JoyeuxNoël fonction très biens soff la dernière colonne ou sa m'affiche #n/a

Oui effectivement, j'avais laissé ton

PMPad2 = Range(PMP1).Offset(0, 6).Address

tout en modifiant un truc à côté. Il faut remplacer ,6 par ,7 et c'est tout bon.

Ma version est plus proche de la tienne (je ne suis pas un pro), donc plus facilement compréhensible par toi (et par moi).

La version de gmb est juste le top, mais faut s'accrocher un peu pour reproduire ça ^^

Merci joyeuxNoël, déjà tu as reçu a comprendre mon code qui est incompréhensible et je t'en remercie, s'est le

PMP1 = Range("h2:h1000").Find(Range("g1").Value, LookIn:=xlValues).Address

le "lookln:=xlValues" qui me manquait ?

Non, ça marche sans, c'est plus une habitude qu'autre chose.

Je ne te cache pas que j'ai changé pas mal de choses qui allaient moyennement ...

Mais c'est surtout vers la fin que ça coinçait.

Range(PMPad & ":" & PMPad2).Select 'Tu sélectionnes une plage de 7 colonnes
Selection.Copy 'tu la copies
Sheets("HOME").Activate 'tu actives la feuille home
ligne = Sheets("HOME").Range("BE29:B999999").End(xlUp).Row + 1 ' Ça te donne 27 à chaque fois dans ta boucle. La structure n'est pas bonne pour récupérer la dernière ligne occupée. J'ai donc changé ça. En plus, tu mets BE29:B999.. il manque le E de BE dans ta 2ème partie de la plage.
Range("Be" & ligne).Select 'tu te places sur ce que tu penses être la bonne cellule
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ ' tu dis que la cellule doit être égale aux valeurs de la plage de 7 colonnes, ça coince aussi
        :=False, Transpose:=False

Merci beaucoup

Je vois que j'ai encore beaucoup de progrès a faire

Je vous souhaite une bonne journée a vous.

Le même avec macro commentée.

Bye !

re

bonjour

juste en passant je corrige la première version de gmp qui n’était pas parfaite (sans vouloir offenser personne)

1 quand on navigue de feuille en feuille prévoir que la macro peut être déclenchée quand feuille source non active (on précise le parent du range)

2 le concat de la ligne pour tester( si non vide )il y a des outils pour ça ....heureusement que le tablo ne fait pas 50 colonnes (LOL)

3 les variables ;et il vraiment nécessaire quelle soient (globales module) et prennent de la place dans la mémoire pour rien

donc juste un peu retouché ça donne ceci

Option Explicit
Sub Exporter()
    Dim fh As Worksheet, fc As Worksheet, tablo, tabloR(), i&, j&, k&

    Set fh = Sheets("Home")
    Set fc = Sheets("calcul2")

    'tablo = Range("I3:O" & Range("I" & Rows.Count).End(xlUp).Row)
    tablo = fc.Range("I3:O" & Range("I" & Rows.Count).End(xlUp).Row)

    k = 0
    For i = 1 To UBound(tablo, 1)
        'If tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4) & tablo(i, 5) _
         & tablo(i, 6) & tablo(i, 7) <> "" Then
        If Join(Application.Index(tablo, i, 0), "") <> "" Then
            ReDim Preserve tabloR(1 To 7, 1 To k + 1)
            For j = 1 To 7
                tabloR(j, k + 1) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i

    With fh.Range("BE27:BK" & Rows.Count)
        .ClearContents
        .Resize(UBound(tabloR, 2), 7) = Application.Transpose(tabloR)
        .Parent.Activate
    End With
End Sub

étonnant c'est même plus rapide

dans la démo ci dessous on vois bien que je lance la macro alors que le sheet actif est "home" et non "calcul"