dato opslag - Visual Basic i Excel

Skal bruge funktionen i arbejdsregi, så... vigtigt.

Har du datoer i kolonne A i ArkA og det samme i kolonne A i ArkB.
Data der så skal hentes i ArkA er så i kolonne B og ud til højre , Forskellig antal celler ????.

noget i denne stil, der tjekkes om der står noget i B kolonne i ArkB, hvis der gør det, skrives der ikke.

Public Sub Opdater()
    Dim DataA As Variant, DataB As Variant, I As Long, X As Long, Y As Integer
    DataA = Worksheets("A").Range("A1").CurrentRegion
    DataB = Worksheets("B").Range("A1:B" & Worksheets("B").Range("A65536").End(xlUp).Row)
    For I = 1 To UBound(DataB)
        For X = 1 To UBound(DataA)
            If DataB(X, 1) = DataA(I, 1) And IsEmpty(DataB(X, 2)) Then
                For Y = 2 To UBound(DataA, 2)
                    Worksheets("B").Cells(I, Y) = DataA(X, Y)
                Next
            End If
        Next
    Next
End Sub

en lidt hurtigere
Public Sub Opdater()
    Dim DataA As Variant, DataB As Variant, I As Long, X As Long, Y As Integer
    Application.ScreenUpdating = False
    DataA = Worksheets("A").Range("A1").CurrentRegion
    DataB = Worksheets("B").Range("A1:B" & Worksheets("B").Range("A65536").End(xlUp).Row)
    For I = 1 To UBound(DataB)
        For X = 1 To UBound(DataA)
            If DataB(X, 1) = DataA(I, 1) And IsEmpty(DataB(X, 2)) Then
                For Y = 2 To UBound(DataA, 2)
                    If Not IsEmpty(DataA(X, Y)) Then
                        Worksheets("B").Cells(I, Y) = DataA(X, Y)
                    End If
                Next
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

Mit datofelt (d.d.) er placeret i A3 i ark A, mens datofelterne er i række
1 fx. C til AG - startende med 1 - sluttende med 31. Uden at være særlig stærk i VBA, tror jeg ikke, at det er den ovenstående, jeg skal bruge, da fx. kolonner for lørdag og søndage bør forblive tomme.
Altså vil test for om forrig kollonnes felter har indhold ikke kunne opfylde ønsket her.

kan du sende et eksempel ark ??

kabbak snabela tiscali dot dk

Modtaget, hvor ser jeg om det er aften eller daghold.

retuneret

det blev til 4 kommandoknapper med kode

Private Sub OpdaterB_aftenhold_Click()
    Dim DL As Variant, DV As Variant, I As Integer
    With Worksheets("B")
        ' Aftenhold B linjen
        DL = [B_Liste]
        DV = [B_Data]
        For I = 1 To UBound(DL, 2)
            If DL(1, I) = [B_Dag] Then
                .Range(.Cells(7, I + 2), .Cells(10, I + 2)) = DV
                Exit For
            End If
        Next
    End With
    ' [B_Ind].ClearContents 'tømmer cellerne der skal tastes i, de gule
      MsgBox " Linie B aftenhold opdateret"
End Sub

Private Sub OpdaterB_Daghold_Click()
    Dim DL As Variant, DV As Variant, I As Integer
    With Worksheets("B")
        ' Daghold B linjen
        DL = [B_Liste]
        DV = [B_Data]
        For I = 1 To UBound(DL, 2)
            If DL(1, I) = [B_Dag] Then
                .Range(.Cells(3, I + 2), .Cells(6, I + 2)) = DV
                Exit For
            End If
        Next
    End With
    ' [B_Ind].ClearContents 'tømmer cellerne der skal tastes i, de gule
    MsgBox " Linie B daghold opdateret"
End Sub

Private Sub OpdaterE_Daghold_Click()
    With Worksheets("B")
        'Daghold E linjen
        DL = [E_Liste]
        DV = [E_Data]
        For I = 1 To UBound(DL, 2)
            If DL(1, I) = [E_Dag] Then
                .Range(.Cells(12, I + 2), .Cells(15, I + 2)) = DV
                Exit For
            End If
        Next
    End With
    '[E_Ind].ClearContents 'tømmer cellerne der skal tastes i, de gule
      MsgBox " Linie E daghold opdateret"
End Sub

Private Sub OpdatererE_aftenhold_Click()
    With Worksheets("B")
        'Aftenhold E linjen
        DL = [E_Liste]
        DV = [E_Data]
        For I = 1 To UBound(DL, 2)
            If DL(1, I) = [E_Dag] Then
                .Range(.Cells(16, I + 2), .Cells(19, I + 2)) = DV
                Exit For
            End If
        Next
    End With

    '[E_Ind].ClearContents 'tømmer cellerne der skal tastes i, de gule
      MsgBox " Linie E Aftenhold opdateret"
End Sub