vba trouve quelque chose dans une feuille de calcul et copie la valeur au même endroit dans une autre feuille de calcul

Question

Cela me rend fou, cela fait maintenant deux semaines que je suis sur ce sujet et je n'arrive à rien, et ce n'est que la première partie d'un projet assez compliqué (pour moi). J'ai un classeur avec 3 feuilles (disponibilité)(allocation)(final). Je collecte les disponibilités des personnes et j'espère pouvoir effectuer une série de tâches. La colonne (a) contient une liste de noms de personnes (elle n'est pas fixe et peut s'étendre et se contracter), les titres des autres colonnes sont des dates (elles ne sont pas fixes et peuvent s'étendre et se contracter). Je dois d'abord effectuer une recherche dans toutes les colonnes ( en disponibilité) et trouver une instance de (x1), enregistrer le nom de la personne et l'adresse de la cellule où (x1) a été trouvé. C'est ce que j'ai fait et en utilisant ( immediate) je peux voir que le nom et l'emplacement de la cellule sont trouvés. La prochaine étape est d'ouvrir la feuille d'allocation, de trouver le nom de la personne et de mettre (x1) dans la même cellule que celle où il a été trouvé. J'ai ajouté le code pour activer les feuilles de calcul (allocation) et définir la plage dans laquelle je veux que la recherche du nom commence, mais lorsque j'exécute le code, il arrive à la ligne "Worksheets("allocation").Activate" et donne l'erreur "Application-defined or object-defined error". Je ne sais pas pourquoi. Vous verrez dans le code que je suis un vrai débutant avec VBA car je suis sûr qu'il y a une manière beaucoup plus efficace d'écrire ce code, mais c'est ce que j'ai trouvé après 2 semaines de recherche laborieuse. Si vous êtes en mesure de m'aider ou de suggérer des améliorations, je vous demanderais de bien vouloir commenter le code pour que je sache ce qu'il fait, sinon je ne pourrai jamais comprendre ce qui se passe et apprendre quoi que ce soit.

Private Sub CommandButton1_Click()

'Dim namerange As Range
'Dim namecell As Range
'Dim firstcell As String
'Dim singlecell As Range
Dim listofcellsb As Range
Dim listofcellsc As Range
Dim listofcellsd As Range
Dim listofcellse As Range
Dim listofcellsf As Range
Dim listofcellsg As Range
Dim listofcellsh As Range
Dim listofcellsi As Range
Dim listofcellsj As Range
Dim listofcellsk As Range
Dim listofcellsl As Range
Dim listofcellsm As Range
Dim listofcellsn As Range
Dim listofcellso As Range
Dim listofcellsp As Range
Dim listofcellsq As Range
Dim listofcellsr As Range
Dim listofcellss As Range
Dim listofcellst As Range
Dim listofcellsu As Range
Dim listofcellsv As Range
Dim listofcellsw As Range
Dim listofcellsx As Range
Dim listofcellsy As Range
Dim listofcellsz As Range
Dim addresscell As String
Dim namecell As String

Set listofcellsb = Range("b4", Range("b3").End(xlDown))

Worksheets("allocation").Activate
Range("a3").Select

    For Each singlecellb In listofcellsb
        If singlecellb.Value = "x1" Then
            Debug.Print singlecellb.Offset(0, 0).Address
            ActiveCell.Value = singlecellb.Offset(0, -1).Value
        End If
    Next singlecellb
Worksheets("availability").Activate

Set listofcellsc = Range("c4", Range("c3").End(xlDown))
    For Each singlecellc In listofcellsc
        If singlecellc.Value = "x1" Then
            Debug.Print singlecellc.Offset(0, 0).Address
            Debug.Print singlecellc.Offset(0, -2).Value
        End If
    Next singlecellc

Set listofcellsd = Range("d4", Range("d3").End(xlDown))
    For Each singlecelld In listofcellsd
        If singlecelld.Value = "x1" Then
            Debug.Print singlecelld.Offset(0, 0).Address
            Debug.Print singlecelld.Offset(0, -3).Value
        End If
    Next singlecelld

Set listofcellse = Range("e4", Range("e3").End(xlDown))
    For Each singlecelle In listofcellse
        If singlecelle.Value = "x1" Then
            Debug.Print singlecelle.Offset(0, 0).Address
            Debug.Print singlecelle.Offset(0, -4).Value
        End If
    Next singlecelle

Set listofcellsf = Range("f4", Range("f3").End(xlDown))
    For Each singlecellf In listofcellsf
        If singlecellf.Value = "x1" Then
            Debug.Print singlecellf.Offset(0, 0).Address
            Debug.Print singlecellf.Offset(0, -5).Value
        End If
    Next singlecellf

Set listofcellsg = Range("g4", Range("g3").End(xlDown))
    For Each singlecellg In listofcellsg
        If singlecellg.Value = "x1" Then
            Debug.Print singlecellg.Offset(0, 0).Address
            Debug.Print singlecellg.Offset(0, -6).Value
        End If
    Next singlecellg

Set listofcellsh = Range("h4", Range("h3").End(xlDown))
    For Each singlecellh In listofcellsh
        If singlecellh.Value = "x1" Then
            Debug.Print singlecellh.Offset(0, 0).Address
            Debug.Print singlecellh.Offset(0, -7).Value
        End If
    Next singlecellh

Set listofcellsi = Range("i4", Range("i3").End(xlDown))
    For Each singlecelli In listofcellsi
        If singlecelli.Value = "x1" Then
            Debug.Print singlecelli.Offset(0, 0).Address
            Debug.Print singlecelli.Offset(0, -8).Value
        End If
    Next singlecelli

Set listofcellsj = Range("j4", Range("j3").End(xlDown))
    For Each singlecellj In listofcellsj
        If singlecellj.Value = "x1" Then
            Debug.Print singlecellj.Offset(0, 0).Address
            Debug.Print singlecellj.Offset(0, -9).Value
        End If
    Next singlecellj

Set listofcellsk = Range("k4", Range("k3").End(xlDown))
    For Each singlecellk In listofcellsk
        If singlecellk.Value = "x1" Then
            Debug.Print singlecellk.Offset(0, 0).Address
            Debug.Print singlecellk.Offset(0, -10).Value
        End If
    Next singlecellk

Set listofcellsl = Range("l4", Range("l3").End(xlDown))
    For Each singlecelll In listofcellsl
        If singlecelll.Value = "x1" Then
            Debug.Print singlecelll.Offset(0, 0).Address
            Debug.Print singlecelll.Offset(0, -11).Value
        End If
    Next singlecelll

Set listofcellsm = Range("m4", Range("m3").End(xlDown))
    For Each singlecellm In listofcellsm
        If singlecellm.Value = "x1" Then
            Debug.Print singlecellm.Offset(0, 0).Address
            Debug.Print singlecellm.Offset(0, -12).Value
        End If
    Next singlecellm

Set listofcellsn = Range("n4", Range("n3").End(xlDown))
    For Each singlecelln In listofcellsn
        If singlecelln.Value = "x1" Then
            Debug.Print singlecelln.Offset(0, 0).Address
            Debug.Print singlecelln.Offset(0, -13).Value
        End If
    Next singlecelln

Set listofcellso = Range("o4", Range("o3").End(xlDown))
    For Each singlecello In listofcellso
        If singlecello.Value = "x1" Then
            Debug.Print singlecello.Offset(0, 0).Address
            Debug.Print singlecello.Offset(0, -14).Value
        End If
    Next singlecello

Set listofcellsp = Range("p4", Range("p3").End(xlDown))
    For Each singlecellp In listofcellsp
        If singlecellp.Value = "x1" Then
            Debug.Print singlecellp.Offset(0, 0).Address
            Debug.Print singlecellp.Offset(0, -15).Value
        End If
    Next singlecellp

Set listofcellsq = Range("q4", Range("q3").End(xlDown))
    For Each singlecellq In listofcellsq
        If singlecellq.Value = "x1" Then
            Debug.Print singlecellq.Offset(0, 0).Address
            Debug.Print singlecellq.Offset(0, -16).Value
        End If
    Next singlecellq

Set listofcellsr = Range("r4", Range("r3").End(xlDown))
    For Each singlecellr In listofcellsr
        If singlecellr.Value = "x1" Then
            Debug.Print singlecellr.Offset(0, 0).Address
            Debug.Print singlecellr.Offset(0, -17).Value
        End If
    Next singlecellr

Set listofcellss = Range("s4", Range("s3").End(xlDown))
    For Each singlecells In listofcellss
        If singlecells.Value = "x1" Then
            Debug.Print singlecells.Offset(0, 0).Address
            Debug.Print singlecells.Offset(0, -18).Value
        End If
    Next singlecells

Set listofcellst = Range("t4", Range("t3").End(xlDown))
    For Each singlecellt In listofcellst
        If singlecellt.Value = "x1" Then
            Debug.Print singlecellt.Offset(0, 0).Address
            Debug.Print singlecellt.Offset(0, -19).Value
        End If
    Next singlecellt

Set listofcellsu = Range("u4", Range("u3").End(xlDown))
    For Each singlecellu In listofcellsu
        If singlecellu.Value = "x1" Then
            Debug.Print singlecellu.Offset(0, 0).Address
            Debug.Print singlecellu.Offset(0, -20).Value
        End If
    Next singlecellu

Set listofcellsv = Range("v4", Range("v3").End(xlDown))
    For Each singlecellv In listofcellsv
        If singlecellv.Value = "x1" Then
            Debug.Print singlecellv.Offset(0, 0).Address
            Debug.Print singlecellv.Offset(0, -21).Value
        End If
    Next singlecellv

Set listofcellsw = Range("w4", Range("w3").End(xlDown))
    For Each singlecellw In listofcellsw
        If singlecellw.Value = "x1" Then
            Debug.Print singlecellw.Offset(0, 0).Address
            Debug.Print singlecellw.Offset(0, -22).Value
        End If
    Next singlecellw

Set listofcellsx = Range("x4", Range("x3").End(xlDown))
    For Each singlecellx In listofcellsx
        If singlecellx.Value = "x1" Then
            Debug.Print singlecellx.Offset(0, 0).Address
            Debug.Print singlecellx.Offset(0, -23).Value
        End If
    Next singlecellx

Set listofcellsy = Range("y4", Range("y3").End(xlDown))
    For Each singlecelly In listofcellsy
        If singlecelly.Value = "x1" Then
            Debug.Print singlecelly.Offset(0, 0).Address
            Debug.Print singlecelly.Offset(0, -24).Value
        End If
    Next singlecelly

Set listofcellsz = Range("z4", Range("z3").End(xlDown))
    For Each singlecellz In listofcellsz
        If singlecellz.Value = "x1" Then
            Debug.Print singlecellz.Offset(0, 0).Address
            Debug.Print singlecellz.Offset(0, -25).Value
        End If
    Next singlecellz

'Worksheets("allocation").Activate

End Sub

Answer 1

Vous pouvez essayer d'ajouter ThisWorkbook. avant Worksheets comme KeenLearner l'a mentionné, ou vous pouvez simplement utiliser directement le nom de l'objet (je suppose que cela dépend de la version du langage Excel).

Sub test()

List1.Activate
Range("a3").Select

End Sub

Answer 2

Si je vous ai bien compris, vous recherchez quelque chose comme ceci.

Cette opération parcourt les colonnes 2 à 26 de la feuille de disponibilité et copie tous les X1 dans la colonne correspondante de la feuille d'allocation (dans la ligne portant le même nom).

Créez un nouveau module en cliquant avec le bouton droit de la souris dans la fenêtre de projet de l'éditeur VBA et en sélectionnant Insérer.... Module. Collez ensuite le code ci-dessous - Vous devrez ensuite appeler ce sous-module dans l'événement de clic du bouton de commande.

Public Sub copyX1s()
Dim listofcells As Range
Dim currentname As String
Dim foundRow As Integer
Dim foundColumn As Integer
Dim i as integer

For i = 2 To 26

    Sheets("Availability").Activate
    Sheets("Availability").Range("A2").Select
    If Not Sheets("Availability").Cells(2, i) = "" Then
        Sheets("Availability").Range(Cells(2, i), Cells(2, i).End(xlDown)).Select
    Else
        GoTo skip:  'If the column has no data then skip to next column
    End If
    Set listofcells = Selection

    Sheets("Allocation").Activate
    Sheets("Allocation").Range("A2").Select

    For Each singleCell In listofcells
        If singleCell = "X1" Then
            foundColumn = singlecell.Column
            currentName = Sheets("Availability").Range("A" & singleCell.Row)
            Set foundName = Sheets("Allocation").Range("A:A").Find(What:=currentName, LookIn:=xlValues)
            foundRow = foundName.Row
            Sheets("Allocation").Cells(foundRow, foundColumn) = "X1"
        End If
    Next singleCell
skip:
Next i

End Sub

La boucle for each à la fin récupère le numéro de la colonne où "X1" a été trouvé et le nom de la personne dans la colonne A. Elle trouve ensuite la ligne avec ce nom de personne dans "Allocation" (au cas où les noms sont dans un ordre différent). Elle place ensuite "X1" dans la cellule correspondante de la feuille "Allocation".