VBA aanpassen over diverse tabbladen

[moensk]

Ik heb 2 scripts die het goed doen
script 1 = verdelen
deze doet aan de hand van een waarde in een bepaalde kolom kijken naar de bijbehorende Sheet en deze aanvullen met nieuwe zendingen en dubbele rijen weghalen

script 2 = UpdateData
deze doet bepaalde velden in een sheet bijwerken.
zou super mijn moest de functionaliteit "bepaalde waarde in kolom koppelen aan bijhorende sheet" kunnen verwerkt worden in dit script.
dan moet ik niet voor elke tabblad een apart "Updatedata" script maken.
beide scripts hieronder

Sub Verdelen()
Dim x As Integer
    Dim DoelSheet As String
    With Sheets("Data")
        For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
            If Not .Rows(x).Hidden Then
                DoelSheet = .Range("AU" & x).Value
                If DoelSheet <> "" Then
                    .Range("A" & x & ":Z" & x).Copy Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Range("A" & Sheets(DoelSheet).Rows.Count).End(xlUp).Row + 1)
                    Sheets(DoelSheet).Cells(1).CurrentRegion.RemoveDuplicates 3
                End If
            End If
        Next x
    End With
End Sub

Public Sub UpdateData()
Const WS As String = "DelHaize"
Dim lngLastRow As Long, lngRow As Long
Dim rs As Object
Dim cn As Object
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
rs.Open "Select * From [Data$]", cn, 2, 1, adCmdTable   '2=cursor type dynamic, 1=readonly
'Debug.Print rs.Fields("Opdrachtnummer").Type
With Sheets(WS)
    lngLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    'Debug.Print lngLastRow
    For lngRow = 2 To lngLastRow
        rs.Find "Opdrachtnummer = " & .Range("C" & lngRow), 1
        If Not rs.EOF Then
            'Debug.Print rs.Fields("Opdrachtnummer")
            .Range("N" & lngRow) = rs.Fields("PP")
            .Range("O" & lngRow) = rs.Fields("LDM")
            .Range("P" & lngRow) = rs.Fields("GEWICHT")
            .Range("Q" & lngRow) = rs.Fields("ZENDINGSTATUS")
            .Range("R" & lngRow) = rs.Fields("WAGEN")
        End If
        rs.movefirst
    Next
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
MsgBox "sheets bijgewerkt"
End Sub

 

[AHulpje]

Misschien zoiets:

Sub UpdateAll()
    UpdateData "DelHaize"
    UpdateData "Carrefour"
    UpdateData "AlbertHeijn"
    MsgBox "sheets bijgewerkt"
End Sub


Public Function UpdateData(WS As String)

 

[moensk]

Ahulpje werkt super