VBA Lookup Loop

Question

Je dois faire une boucle et j'ai le plus de mal. Ce que j'essaie d'accomplir est de parcourir toutes les valeurs dans la colonne A de 'Assum'. Les valeurs commencent à A5. Je veux ensuite qu'il recherche la même valeur sur 'Sheet1' et vérifie la valeur de la 5ème colonne (E). En fonction de la valeur dans E (A, B, C), il effectue l'une des trois tâches. La tâche pour C consiste à prendre la valeur d'origine, et rechercher cette valeur dans 'ECData', et prendre des plages spécifiques et les coller sur une 4ème feuille 'Travail'. Ce qui se passe réellement: Il copie les cellules de la ligne incorrecte sur 'ECData' plutôt que de trouver la ligne spécifique et de coller sa ligne correspondante. Je sais que le code est en désordre, j'essaie de bousculer des morceaux d'un autre code qui accomplit ce que je veux.

Des pensées? MS Office 2013

Public y1 As Integer 

Sub ECLoop() 


Dim i As Single 
Dim finalRow As Long 



finalRow = Sheets("Assum").Cells(Rows.Count, 1).End(xlUp).Row 

For i = 5 To finalRow 
     If Sheets("Sheet1").Cells(i, 5) = "A" Then 
      Sheets("Assum").Cells(i, 2) = "Test A" 
     ElseIf Sheets("Sheet1").Cells(i, 5) = "B" Then 
      Sheets("Assum").Cells(i, 2) = "Test B" 
     ElseIf Sheets("Sheet1").Cells(i, 5) = "C" Then 
      Set FoundCell = ActiveCell 
       If Not FoundCell Is Nothing Then 
       y1 = FoundCell.Row 
       End If 
      Set NationalPaste = Sheets("Work").Range("Z3") 
      Set OverPaste = Sheets("Work").Range("Z24") 
      Set UnderPaste = Sheets("Work").Range("Z45") 
      Set IFPPaste = Sheets("Work").Range("Z66") 
      Set SeniorsPaste = Sheets("Work").Range("Z87") 
      Sheets("ECData").Select 
       With Sheets("ECData") 
        Set National = Range(Cells(y1, 2), Cells(y1, 21)) 
        Set Over = Range(Cells(y1, 22), Cells(y1, 41)) 
        Set Under = Range(Cells(y1, 42), Cells(y1, 61)) 
        Set IFP = Range(Cells(y1, 62), Cells(y1, 81)) 
        Set Seniors = Range(Cells(y1, 82), Cells(y1, 101)) 
       End With 


      Sheets("Work").Range("Z3:Z22").ClearContents 
      National.Copy 
      NationalPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

      Sheets("Work").Range("Z24:Z43").ClearContents 
      Over.Copy 
      OverPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

      Sheets("Work").Range("Z45:Z64").ClearContents 
      Under.Copy 
      UnderPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

      Sheets("Work").Range("Z66:Z85").ClearContents 
      IFP.Copy 
      IFPPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

      Sheets("Work").Range("Z87:Z106").ClearContents 
      Seniors.Copy 
      SeniorsPaste.PasteSpecial Paste:=xlValues, Transpose:=True 
     Else 
      Exit Sub 
     End If 
Next i 
End Sub 

Answer 1

Cela peut ne pas répondre complètement à votre question, mais il est beaucoup trop long pour un commentaire. Si vous répondez à mes questions (voir les commentaires du code), je le mettrai à jour pour corriger ce que je pense être votre problème; cependant, vous pouvez probablement le faire vous-même avec l'information ci-dessous). J'ai aussi rangé votre code un peu

' Use Option Explicit to ensure all variables are declared - will save you a lot of debugging time 
Option Explicit 
Sub ECLoop() 
    ' Make sure you declare all your variables 
    ' Why is y1 public? Is it used elsewhere? Try to keep it local 
    Dim i As Long, finalRow As Long, y1 As Long 
    Dim NationalPaste As Range, OverPaste As Range, UnderPaste As Range, IFPPaste As Range, SeniorsPaste As Range 
    Dim FoundCell As Range, National As Range, Over As Range, Under As Range, IFP As Range, Seniors As Range 

    finalRow = Sheets("Assum").Cells(Rows.Count, 1).End(xlUp).Row 

    With Sheets("Work") 
     Set NationalPaste = .Range("Z3") 
     Set OverPaste = .Range("Z24") 
     Set UnderPaste = .Range("Z45") 
     Set IFPPaste = .Range("Z66") 
     Set SeniorsPaste = .Range("Z87") 
    End With 

    For i = 5 To finalRow 
     If Sheets("Sheet1").Cells(i, 5) = "A" Then 
      Sheets("Assum").Cells(i, 2) = "Test A" 
     ElseIf Sheets("Sheet1").Cells(i, 5) = "B" Then 
      Sheets("Assum").Cells(i, 2) = "Test B" 
     ElseIf Sheets("Sheet1").Cells(i, 5) = "C" Then 
      ' I think this is causing your error as it will always be the same 
      ' Set this to what it should be e.g. Set FoundCell = Sheets("Assum").Cells(i,1) 
      Set FoundCell = ActiveCell 
      ' This If is fairly pointless as it will always be set. You also don't seem to resuse FoundCell 
      ' So why not just set y1 straight away 
      If Not FoundCell Is Nothing Then 
       y1 = FoundCell.Row 
      End If 

      With Sheets("ECData") 
       Set National = .Range(.Cells(y1, 2), .Cells(y1, 21)) 
       Set Over = .Range(.Cells(y1, 22), .Cells(y1, 41)) 
       Set Under = .Range(.Cells(y1, 42), .Cells(y1, 61)) 
       Set IFP = .Range(.Cells(y1, 62), .Cells(y1, 81)) 
       Set Seniors = .Range(.Cells(y1, 82), .Cells(y1, 101)) 
      End With 

      With Sheets("Work") 
       .Range("Z3:Z22").ClearContents 
       National.Copy 
       NationalPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

       .Range("Z24:Z43").ClearContents 
       Over.Copy 
       OverPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

       .Range("Z45:Z64").ClearContents 
       Under.Copy 
       UnderPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

       .Range("Z66:Z85").ClearContents 
       IFP.Copy 
       IFPPaste.PasteSpecial Paste:=xlValues, Transpose:=True 

       .Range("Z87:Z106").ClearContents 
       Seniors.Copy 
       SeniorsPaste.PasteSpecial Paste:=xlValues, Transpose:=True 
      End With 
     Else 
      ' Do you really want it to quit if the the cell doesn't equal your test conditions 
      ' What about the rest of the cells? 
      Exit Sub 
     End If 
    Next i 
End Sub