Úprava kódu vba

Dobrý den,
poprosil bych o radu, mám kód ve vba na aktualizaci údajů, potřeboval bych, aby se mi nenačítaly aktualizované údaje z externího souboru AktBunek2.xlsx, ale z listu4 v aktuálním souboru. Už se s tím trápím dobu a furt mi to nechodí, dokážete prosím poradit? Díky. Zde je funkční kód pro aktualizaci z externího souboru:

Option Explicit

Sub Aktualizovat()
Dim Bunka As Range, AktBlok As Range, c As Range, MsgTit As String, MsgResponse As String
Dim SesitCeny As Workbook, ListCeny As Worksheet, BlokCeny As Range, CestaSoubor As String, List As String
MsgTit = "Aktualizace"
CestaSoubor = "C:\Users\Bobik\Desktop\pokusexcel\AktBunek2.xlsx" ' cesta a soubor s aktualnimi cenami dodavatele
List = "List1" ' list s aktualnimi cenami
Set AktBlok = ActiveWorkbook.Worksheets("List1").UsedRange
Set AktBlok = AktBlok.Resize(AktBlok.Rows.Count, 1)
'otevrit sesit a list s aktualnimi cenami dodavatele
On Error GoTo Err1
Set SesitCeny = Workbooks.Open(CestaSoubor)
On Error GoTo Err2
Set ListCeny = SesitCeny.Worksheets(List)
' produkt je v 1. sloupci a cena ve 2. sloupci
Set BlokCeny = ListCeny.UsedRange
Set BlokCeny = BlokCeny.Resize(BlokCeny.Rows.Count, 1)
For Each Bunka In AktBlok.Cells
Set c = BlokCeny.Find(Bunka.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Bunka.Offset(0, 8).Value = c.Offset(0, 1).Value
End If
Next Bunka
SesitCeny.Close
Exit Sub
Err1:
MsgResponse = MsgBox("Soubor " & CestaSoubor & " nelze nalézt," & vbCrLf _
& " zkontrolujte jeho název a umísti`ní v adresá?i!", vbOKOnly + vbCritical, MsgTit)
Exit Sub
Err2:
MsgResponse = MsgBox("List " & List & " v souboru " & CestaSoubor & vbCrLf _
& " nelze nalézt, zkontrolujte jeho název!", vbOKOnly + vbCritical, MsgTit)
SesitCeny.Close
End Sub