overfør data til andet ark via flere værdier.

Hey jeg har lavet en kode som tager noget data fra et ark over til et andet via 2 værdier
søgeværdi 1
er for at find ud af hvilken række den skal indskrive på
søgeværdi 2
Er for at hvilken kolonne den skal finde en værdi
på min mappe main har jeg en dato i "J1" som er søgeværdi 1
Og tekst/tal i A3:A62 som er søgeværdi 2

på mit andet ark har jeg datoer i "A:A" og værdier i kolonnerne.
det den så gør er hvis søgeværdi findes på den række som datoen blev fundet, skriver den værdier fra main ud for søgeværdi 2 i H, i, j, l. 4 værdier som den indsætter på planark.
F. Eks Hvis søgeværdi = række 200 og søgeværdi 2 = test og findes på main række 15.
og findes på planark/ark 1 to 4 de fire første ark I række 1
hvis den findes eks finder den i kolonne Q ud for dato rækken

vil den ønskede celle være q200, og det den så vil er tage H15 = Q201 og I15 = R201 og I15 = R200 og den sidste værdi L15 = S200

når den har gjort det lukker den planarket ned og gemmer

men det jeg har problemer med er at få den til at forstå at den skal finde datoen på planarket for at kunne rinde rækken

den bliver ved med at tage main selv om jeg har skåret det ud på alle de måder jeg kender men den den forstår det bare ikke.

Har en anden som gør næsten det samme bare via userforms og mange mapper og den virker fint.

Hvis der er en som kan se hvad jeg gør forkert og få den til at gøre som man ønsker.

Sub Gem()
Dim Arr(255, 4)
Dim Arr2(59, 1)
Dim Arr3(59, 1)
Dim Arr4(59, 1)
Dim Arr5(59, 1)
Dim Arr6(59, 1)
Dim i, o, p, k As Integer
Dim rng As Range
Dim FindDato As String
Cells(1, 7) = "Gemmer!!"
Cells(1, 7).Offset(, -6).Resize(1, 6).Font.ColorIndex = 3
Cells(1, 7).Offset(, 1).Resize(1, 5).Font.ColorIndex = 3
Cells(1, 7).Offset(, -6).Resize(1, 12).Interior.ColorIndex = 3
Application.ScreenUpdating = False
FindDato = Cells(1, 10)
On Error Resume Next
Workbooks("Planark.xls").Activate
If Err.Number <> 0 Then Workbooks.Open "\\server\Data\DOKUMENTER\Kørsel\Ny Bemanding\Planark.xls", Password:="pass"
If Application.Wait(Now + TimeValue("0:00:02")) Then
End If
For Z = 1 To 4
Sheets(Z).Select
Set rng = Range("A:A")
For Each v In rng
    If v.Text = FindDato Then
        p = v.Row
        Exit For
    End If
Next v
For k = 6 To 255
    Arr(k - 1, 0) = Cells(p, k).Value
    Arr(k - 1, 1) = Cells(p, k + 1).Value
    Arr(k - 1, 2) = Cells(p, k + 2).Value
    Arr(k - 1, 3) = Cells(p + 1, k).Value
    Arr(k - 1, 4) = Cells(p + 1, k + 1).Value
Next k
Workbooks("Main.xls").Activate
Sheets("Main").Select
For i = 0 To 59
    Arr2(i) = Cells(i + 3, 1).Value
    Arr3(i) = Cells(i + 3, 8).Value
    Arr4(i) = Cells(i + 3, 9).Value
    Arr5(i) = Cells(i + 3, 10).Value
    Arr6(i) = Cells(i + 3, 12).Value
Next i
Workbooks("Planark.xls").Activate
Sheets(ArkP).Select
For k = 6 To 255
    For i = 0 To 59
    j = i + 3
    If Arr2(i) = Arr(k - 1, 0) Then
        Cells(p + 1, k).Value = Format(Arr3(i), "hh:mm") 'start
        Cells(p + 1, k + 1).Value = Format(Arr4(i), "hh:mm") 'slut
        Cells(p, k + 1).Value = Arr5(i) 'info
        Cells(p, k + 2).Value = Arr6(i) 'pause
    End If
  Next i
Next k

Next Z
  ActiveWorkbook.Save
  ActiveWorkbook.Close
  Application.ScreenUpdating = True
  Cells(1, 7) = "Klar om 3 sek!!"
  Cells(1, 7).Offset(, -6).Resize(1, 6).Font.ColorIndex = 4
  Cells(1, 7).Offset(, 1).Resize(1, 5).Font.ColorIndex = 4
  Cells(1, 7).Offset(, -6).Resize(1, 12).Interior.ColorIndex = 4
  ActiveWorkbook.Save
If Application.Wait(Now + TimeValue("0:00:01")) Then
  Cells(1, 7).Offset(, -6).Resize(1, 12).Font.ColorIndex = 0
  Cells(1, 7).Offset(, -6).Resize(1, 12).Interior.ColorIndex = 2
  Cells(1, 7) = ""
End If
End Sub