Automatisation avec code VBA

[duplaly]

j'aimerais automatiser ce code dans mon tableau et je m'explique
Sub Vierge()
Dim i As Byte, j As Long, Lig As Integer
Dim Mot As String, firstAddress As String
Dim Plage As Range, c As Range

Mot = InputBox("Mot à rechercher ?")
If Mot = "" Then Exit Sub

'Selectionne la zone de recherche du mot
Set Plage = Range(Sheets("Empl").Range("J8"), Sheets("Empl").Range("J65536").End(xlUp))

'selectionne la ligne du début du récapitulatif (à partir quelle ligne on va pouvoir insérer les données)
Lig = Sheets("Vierge").Range("A65536").End(xlUp).Row + 1

For Each c In Plage
If InStr(1, c, Mot) <> 0 Then
c.EntireRow.Range("A1:G1").Copy Sheets("Vierge").Cells(Lig, 1)
Lig = Lig + 1
End If
Next c

Sheets("Vierge").Activate
Range("A17").Activate
Application.ScreenUpdating = True
End With

End Sub


En retrant le mot recherché de l' InputBox, est ce que le mot recherché peut être copié automatiquement dans mon code. Au lieu de sheet Vierge, ce serait le mot recherché. Ainsi, les résultats de la recherche iront dans la bonne feuille.
merci

 

[Guest]

Re : Automatisation avec code VBA

Bonjour,

Voici une possibilité. comme tu ne dis rien sur l'existence ou non de la feuille qui correspond au mot, la macro tente de la trouver, si elle ne la trouve pas, demande s'il faut la créer.
si la réponse est oui-> création de la feuille sinon copie les résultat sur la feuille "Vierge".

Sub Vierge()
    Dim i As Byte, j As Long, Lig As Integer
    Dim Mot As String, firstAddress As String
    Dim Plage As Range, c As Range
    Dim sh As Worksheet
    Mot = InputBox("Mot à rechercher ?")
    If Mot = "" Then Exit Sub
    'Selectionne la zone de recherche du mot
    Set Plage = Range(Sheets("Empl").Range("J8"), Sheets("Empl").Range("J65536").End(xlUp))
    'Si au moins un mot a été trouvé dans la plage
    If Application.CountIf(Plage, "*" & Mot & "*") > 0 Then
        On Error Resume Next
        Set sh = Sheets(Mot)
        On Error GoTo 0
        If sh Is Nothing Then
            If MsgBox("La feuille " & Mot & " n'a pas été trouvée!" & vbCrLf & "Voulez-vous la créer?", vbYesNo + vbQuestion, "Vierge") = vbYes Then
                With ThisWorkbook
                    .Sheets.Add after:=Sheets(.Sheets.Count)
                    Set sh = ActiveSheet
                    sh.Name = Mot
                End With
            End If
        End If
        If sh Is Nothing Then Set sh = Sheets("Vierge")
        'selectionne la ligne du début du récapitulatif (à partir quelle ligne on va pouvoir insérer les données)
        Lig = sh.Range("A65536").End(xlUp).Row + 1
        For Each c In Plage
            If InStr(1, c, Mot) <> 0 Then
                c.EntireRow.Range("A1:G1").Copy sh.Cells(Lig, 1)
                Lig = Lig + 1
            End If
        Next c
    sh.Activate
    Range("A17").Activate
    End If
End With
End Sub

Dans tes prochains post utilise l'éditeur avancé et le bouton '#' pour publier tes codes. Il seront plus lisibles.

A+

A+

 

[duplaly]

Re : Automatisation avec code VBA

merci.
tout fonctionne

 

[duplaly]

Re : Automatisation avec code VBA

Allo
le code va bien, cependant je ne veux qu'une nouvelle soit crée. je copier la feuille master dans mon fichier et la renommer avec le nom recherché.
voici le bout de code que j'aimerais mettre au début ou toute autre solution.

Sub duplic()
'Demande du nom
Nom_recherche = Application.InputBox("Quel nom est recherché ?", "Nom ?", , , , , , 2)
Derligne = Range("A65536").End(xlUp).Row

' Copie de la feuille
Worksheets("Master").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Nom_recherche



End Sub

Merci pour votre patience

 

[Guest]

Re : Automatisation avec code VBA

Bonjour,

Pas très clair tout ça. Dernière tentative:

Sub Vierge()
    Dim Lig As Integer
    Dim Nom_recherche As String
    Dim Plage As Range, c As Range
    Dim sh As Worksheet
    
    Nom_recherche = Application.InputBox("Quel nom est recherché ?", "Nom ?", , , , , , 2)
    If Nom_recherche = "" Then Exit Sub
    
    'Selectionne la zone de recherche du Nom_recherche
    Set Plage = Range(Sheets("Empl").Range("J8"), Sheets("Empl").Range("J65536").End(xlUp))
    
    Worksheets("Master").Copy After:=Sheets(Sheets.Count)
    Set sh = ActiveSheet
    sh.Name = Nom_recherche
    'selectionne la ligne du début du récapitulatif (à partir quelle ligne on va pouvoir insérer les données)
    Lig = sh.Range("A65536").End(xlUp).Row + 1
    For Each c In Plage
        If InStr(1, c, Nom_recherche) <> 0 Then
            c.EntireRow.Range("A1:G1").Copy sh.Cells(Lig, 1)
            Lig = Lig + 1
        End If
    Next
End Sub

A+

 

[duplaly]

Re : Automatisation avec code VBA

Merci, tout fonctionne bien