Inhoud van een kolom in een ander werkblad

Status
Niet open voor verdere reacties.
A

adkliko

Gebruiker
Lid geworden
30 aug 2010
Berichten
39
Beste forum leden.

Is het mogelijk om de datum (kolom H) ,pos 6,1 (kolom A) en order nummer (cel D3) te importeren in mijn weekoverzicht.
Dit mag via een knop in mijn voormontage opdracht.
De weekplanning staat altijd op de zelfde plek.

Zo ja hoe moet dit?

Ik moet nu bij elke opdracht deze gegevens invullen in het weekoverzicht.
Het zou me veel tijdschelen als dit met een druk op de knop kan gebeuren.

groetjes marcel
 

Bijlagen

Marcel, je vraag is al 40X bekeken en nog geen reactie. Ik vermoed dat een woordje uitleg extra misschien wel nodig is. Mij is het anderzijds toch ook niet duidelijk hoe en wat je nu feitelijk wil bereiken.
 
Hoi Rudi.

wat is wil berijken is dat ik niet elke keer de laaddatum (zie voormontage opdracht)hoef over te typen in mijn weekoverzicht (zie foto)
Het was helaas niet mogelijk dit overzicht te plaatsen daar dit te groot is.
De notering die ik gebruik in mijn weekoverzicht is het ordernummer en positienummer samen.

Dat er 40 keer gekeken is wil nog niet zeggen dat mijn omschrijving onduidelijk is.

groetjes marcel
 
Maar ondertussen zijn we wel 10 dagen verder en 80X bekeken en nog niets.
Dat er 40 keer gekeken is wil nog niet zeggen dat mijn omschrijving onduidelijk is.
Klik om te vergroten...
Aan wat ik in deze opmerking tussen de regels lees, daar neem ik dus wel aanstoot aan. :mad:
Voor mij eindigt deze vraag dus hier.
Suc6 verder
 
Beste Rudi.

Het is helemaal niet de bedoeling iemand te beledigen in welke vorm dan ook.
Wat ik hier mee bedoel is dat mede forum leden waarschijnlijk geen oplossing hebben voor mijn vraag.

Ik bied jou mijn excuus aan voor de opmerking.

groetjes marcel
 
Begin al eens met onderstaande zodat we kunnen zien waar we uitkomen.
Code: 
Sub tst()
    Workbooks.Open (ThisWorkbook.Path & "\Weekplanning " & Year(Date) & ".xlsm") 'Pad naar Doelbestand
    ThisWorkbook.Activate
    wbTo = Workbooks("Weekplanning " & Year(Date) & ".xlsm").Worksheets("Bladnaam") 'Wijzig in de juiste bladnaam doelbestand
    With Sheets("VM hoofdopdracht")
        ProjNr = .[D3]
        For Each cl In .Range("H10:H" & .Cells(Rows.Count, 8).End(xlUp).Row)
            If cl <> "" Then
                With wbTo.Rows(4).Find(DateValue(cl), , xlValues, xlWhole)
                    If .Offset(1) = "" Then
                        .Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    Else
                        .End(xlDown).Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    End If
                End With
            End If
        Next
    End With
    Workbooks("Weekplanning " & Year(Date) & ".xlsm").Close True
End Sub
 
Hoi Rudi.

Thx voor de code.
Ik heb hem geprobeerd.
Echter verwijst het pad nu naar de map waar de VM opdracht staat.
hoe verander je het pad naar de onderstaande lokatie.
Het huidige pad ziet er als volgt uit.
G:\Installatiegroep\FIG Werkplaats\Orders\4034 Plus schoonhoven

Tevens geeft VB ook een melding.
Deze eigenschap of methode wordt niet ondersteund door dit object.
We gebruiken hier office 2007.

groetjes marcel
 
Welke regel kleurt geel bij de foutmelding ?
Rode tekst was de boosdoener.
Code: 
Sub tst()
    Const WDir = "G:\Installatiegroep\FIG Werkplaats\Orders\4034 Plus schoonhoven"
    Workbooks.Open (WDir & "\Weekplanning " & Year(Date) & ".xlsm") 'Pad naar Doelbestand
    ThisWorkbook.Activate
    [COLOR="red"]Set[/COLOR] wbTo = Workbooks("Weekplanning " & Year(Date) & ".xlsm").Worksheets("Blad1") 'Wijzig in de juiste bladnaam doelbestand
    With Sheets("VM hoofdopdracht")
        ProjNr = .[D3]
        For Each cl In .Range("H10:H" & .Cells(Rows.Count, 8).End(xlUp).Row)
            If cl <> "" Then
                With wbTo.Rows(4).Find(DateValue(cl), , xlValues, xlWhole)
                    If .Offset(1) = "" Then
                        .Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    Else
                        .End(xlDown).Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    End If
                End With
            End If
        Next
    End With
    Workbooks("Weekplanning " & Year(Date) & ".xlsm").Close True
End Sub
 
Laatst bewerkt:
Hoi Rudi.

De eeste foumedling is weg.
Hij komt nu alleen met weer een andere.
en wel met de melding: objectvariabele of blokvariabele with is niet ingesteld

Hij geeft deze error op de regel met: If .Offset(1) = "" Then
Ik heb eerst geprobeerd dit zelf op te lossen.
Maar dit nivo is mij te hoog.

heb je voor mij een oplossing.

groetjes marcel
 
Rij 4 in je weekplanning, zijn dit datums die je ingegeven hebt met een bepaalde opmaak of is dit gewoon tekst, want daar zit wschnlk de fout. Om te werken moeten dit datums zijn.
 
Hoi Rudi.

in kolom 4 staat de datum in datum notering dd-m of te wel 09-3.
Na je tip heb ik gelijk andere datum noteringen geprobeerd maar die weken ook niet.
Hij blijft de foutmelding geven en verwijzen daar If .Offset(1) = "" Then

heb je een idee?
 
Vervang onderstaande
Code: 
With wbTo.Rows(4).Find(DateValue(cl), , xlValues, xlWhole)
door deze
Code: 
With wbTo.Rows(4).Find(Format(cl, "dd-m"), , xlValues, xlWhole)
 
Goedemorgen Rudi.

Ik heb je weiziging door gevoerd.
Alleen die hardnekkige foutmelding blijft.

Ook nu heb ik geprobeerd het in andere datum notities te zetten.
Maar zonder succes.

Ik voeg een afgeslankte versie toe van mijn weekplanning.
Helaas kan ik geen .xlsm bestand toevoegen.
Is dit om rede waarom dit niet kan?

Hopelijk kan je hier iets mee.

alvast bedankt voor al de moeite die je doet.

groetjes marcel
 

Bijlagen

Code: 
With wbTo.Rows(4).Find(Format(cl, "d/mm/yy"), , xlValues, xlWhole)
Had dit vb er van hetbegin bijgeweest had ons dat heel wat tijd bespaard :o
 
Helaas rudi.

ook deze oplossing werkt niet.
Hij blijft de zelfde regel elke keer al fout geven met nog steeds de zelfde melding.

groetjes marcel
 
Niks helaas, dit werkt perfect met het door jou gegeven Voormontagebestand uit Post#1 en het door jou gegeven bestand Weekplanning uit Post#13.
Het is nu aan jou om je originele bestanden in overeenstemming te brengen met de door jou gegeven voorbeelden.
Post de macro nog eens die je nu gebruikt.
 
Hoi Rudi.

Hij blijft het doen.
ook als ik de geuploude bestanden gebruik.
Ik vanavond thuis nog even proberen of het daar wel werkt.


De code die ik nu gebruik is:
Code: 
Sub tst()
    Const WDir = "\\ELW3KSRV101\Users$\LandmanM\DigiOffice"
    Workbooks.Open (WDir & "\Weekplanning " & Year(Date) & ".xlsm") 'Pad naar Doelbestand
    ThisWorkbook.Activate
    Set wbTo = Workbooks("Weekplanning " & Year(Date) & ".xlsm").Worksheets("Weekplanning") 'Wijzig in de juiste bladnaam doelbestand
    With Sheets("VM hoofdopdracht")
        ProjNr = .[D3]
        For Each cl In .Range("H10:H" & .Cells(Rows.Count, 8).End(xlUp).Row)
            If cl <> "" Then
                With wbTo.Rows(4).Find(Format(cl, "d/mm/yy"), , xlValues, xlWhole)
                    If .Offset(1) = "" Then
                        .Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    Else
                        .End(xlDown).Offset(1) = ProjNr & " " & cl.Offset(, -7)
                    End If
                End With
            End If
        Next
    End With
    Workbooks("Weekplanning " & Year(Date) & ".xlsm").Close True
End Sub

groetjes marcel
 
De foutmelding krijg je omdat hij in rij 4 van je weekplanning de datum niet kan vinden. Dus daar zal je ergens moeten zoeken.
 
hoi Rudi

Ook thuis krijg ik het niet voor elkaar met de geposte bestanden en de code die je me gegeven hebt.
Ook nu heb ik geprobeerd met verschillende datum notitie's

Het script blijft halsstarrig de foutmelding geven op de regel van If .Offset(1) = "" Then
Ik krijg het niet voor elkaar om het werkende te krijgen.

Kan je me misschien nog verder op weg helpen?

groetjes marcel
 
Beste adkliko

Bij het invoeren van een datum in een cel wordt de Eigenschap value van de cel standaard in de systeemdatumnotatie opgeslagen, ongeacht de notatie. bijvoorbeeld:
Code: 
Sub Datumformaat()
    
    Range("A1") = "13-03-2011"
    Range("B1") = "13-03-2011"
    
    Range("A1").NumberFormat = "d/m/y"
    Range("B1").NumberFormat = "dd-mm-yyyy"
    'numberformat is niet belangrijk
    If Range("A1") = Range("B1") Then MsgBox "joepie!"

End Sub

Dus ten eerste hoef je voor zoeken geen Format te gebruiken.

Ten tweede de functie Range.Find
Gebruik bij het zoeken naar datums Lookin:=xlFormulas

De eigenschap "xlValues" zoekt in de "displaywaarden" van de cel (vba: Range.Text)
De eigenschap "xlFormulas" zoekt in de Waarde van de cel (vba: Range.Value)

Opmerking: als het celbereik waarin je zoekt formules bevat, werkt range.find niet voor Datums.
Wil je dat wel, dan heb je een ingewikkelder oplossing nodig met bijvoorbeeld een array inlezen (zoekgebied) en deze waarden dan één voor één langsgaan

Probeer dit eerst eens:

Code: 
Sub SaveProj()
'Const WDir = "C:\testmark"
Const WDir = "\\ELW3KSRV101\Users$\LandmanM\DigiOffice"
Dim wbTo As Workbook
Dim rCell As Range
Dim rFound As Range
Dim rProcess As Range
Dim strProj As String
Dim strProjWrite As String

    With ThisWorkbook.Sheets("VM hoofdopdracht")
        Set rProcess = .Range("H10:H" & .Range("H" & Rows.Count).End(xlUp).Row)
        strProj = .Range("D3")
    End With
    
    Set wbTo = Workbooks.Open(WDir & "\Weekplanning " & Year(Date) & ".xlsm")

    For Each rCell In rProcess
        
        strProjWrite = strProj & rCell.Offset(, -7)
    
        If Not rCell = Empty Then
            Set rFound = wbTo.Sheets("Weekplanning").Rows(4).Find( _
                                                WHAT:=rCell, _
                                                lookat:=xlWhole, _
                                                LookIn:=xlFormulas, _
                                                MatchCase:=False)
            WriteProject strProjWrite, rFound
        End If
        
    Next rCell

End Sub

Private Sub WriteProject(ByVal strProj As String, _
                         ByVal rTopCell As Range)
    If Not rTopCell Is Nothing Then
        Range(Split(rTopCell.Address, "$")(1) & 65535).End(xlUp).Offset(1) = strProj
    End If
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan