Opgelost VBA - Verticaal zoeken met variable kolommen

[HWV]

Goedendag,

Ik ben een beetje aan het stoeien met onze tellijsten.
Ik heb twee bestanden, 1 is de tellijst zoals we deze wekelijks tellen (Sheet Getelde artikelen) en de (Sheet etiketten)
Nu wil ik met VBA de gevens van Sheet getelde artikelen overzetten naar de sheet Etiketten.
Enkel zou ik wel wilen dat deze kijkt naar de datum in Sheet Getelede artikelen cel C1 welke datum daar staat en dan in de sheet Etiketten deze dan via VBA vertikaal zoeken de waarde neerzet in de juiste kolom dus de datum die in sheet Getelde artikelen C1 staat.

Ik heb al een code die vba verticaal zoekt, enkel de kolomen waar het heen gaat zijn niet variable
Is dit wel te doen!

Sub VoorraadVerplaatsen()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

On Error Resume Next
    For j = 6 To Sheets("Etiketten").Cells(Rows.Count, 1).End(xlUp).Row 'naar sheet Etiketten
    With Sheets("Getelde artikelen").Columns(1).Find(Sheets("Etiketten").Cells(j, 1).Value) 'van sheet Getelde artikelen naar sheet Etiketten
    .Offset(, 4).Copy
    Sheets("Etiketten").Cells(j, 720).PasteSpecial xlPasteValues 'naar sheet Etiketten
    .Offset(, 5).Copy
    Sheets("Etiketten").Cells(j, 721).PasteSpecial xlPasteValues 'naar sheet Etiketten
    .Offset(, 6).Copy
    Sheets("Etiketten").Cells(j, 722).PasteSpecial xlPasteValues 'naar sheet Etiketten
    End With
  Next

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[Haije]

in de bijlage heb ik C1 in blad 'Getelde artikelen' de naam zoekdatum gegeven.
in D1 staat een formule die weergeeft in welke kolom op blad Étiketten' die datum staat.

Kun je hiermee verder?
zie bijlage

 

[HWV]

Beste,

Ik heb met een hulpkolom het voor elkaar gekregen om de kolomen variable te maken op datum.
Werkt goed, maar zal zeker anders/beter kunnen.
Enkel als je de laatste regel neemt staat in kolom A "FRUI" daar hoeft geen waarde voor te komen maar hier wordt wel een waarde neergezet. Hoe kan ik zoeken met unieke waarde zodat deze regel dan leeg blijf.

Ook zou ik willen als er geen waarde gevonden wordt voor een artikel dat er dan een 0 geplaats wordt

Alvast dank voor de ondersteuning

Henk

 

[HWV]

Beste,

Het geen ik wilde heb ik voor elkaar gekregen met onderstaande code.
Hier zal nog wel een verbetering in gedaan kunnen worden, maar voor nu werkt het zoals het moet werken.

Sub VoorraadVerplaatsen()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

On Error Resume Next
    For j = 6 To Sheets("Etiketten").Cells(Rows.Count, 1).End(xlUp).Row 'naar sheet Etiketten
        
If (Sheets("Etiketten").Cells(j, 3).Value) = "" Then 'van sheet Getelde artikelen naar sheet Etiketten
       Else
        With Sheets("Getelde artikelen").Columns(1).Find(Sheets("Etiketten").Cells(j, 1).Value) 'van sheet Getelde artikelen naar sheet Etiketten
                If .Offset(, 4) = "" Then
                    .Offset(, 4) = "0"
                Else
                   .Offset(, 4).Copy
                End If
            Sheets("Etiketten").Cells(j, Sheets("Hulptabel").Range("G1")).PasteSpecial xlPasteValues 'naar sheet Etiketten
                If .Offset(, 5) = "" Then
                  .Offset(, 5) = "0"
                Else
                   .Offset(, 5).Copy
                End If
            Sheets("Etiketten").Cells(j, Sheets("Hulptabel").Range("H1")).PasteSpecial xlPasteValues 'naar sheet Etiketten
                If .Offset(, 6) = "" Then
                    .Offset(, 6) = "0"
                Else
                    .Offset(, 6).Copy
                End If
            Sheets("Etiketten").Cells(j, Sheets("Hulptabel").Range("I1")).PasteSpecial xlPasteValues 'naar sheet Etiketten
            Sheets("Etiketten").Cells(j, Sheets("Hulptabel").Range("J1")) = 0 'naar sheet Etiketten
        End With
End If
  Next

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Natuurlijk sta ik open voor verbetringen

Henk