regels verplaatsen naar ander blad op wo nummer

[ewh]

Nog een keer proberen,

in de bijlage een voorbeeld wat we ter beschikking hebben
op Blad Basis in kolom T staat het ordernummer
Kolom F staat de omschrijving ( betreft)
Kolom W zijn de kosten

op Blad werkorder staan herhaald twee kolommen, per ordernummer een kolom betreft en een kolom totaal

het is de bedoeling met vba om van het blad basis het order nummer te zoeken op blad werkorder en dan de omschrijving ( betreft) en de bijbehorende kosten juist te plaatsen.

Als dat gebeurd is dan zal het blad Basis worden geschoond en de week er op weer worden gevuld , waarop de kopieer slag weer gemaakt zal moeten worden
ben al weer even aan het puzzelen maar het lukt me echt niet

in het voorbeeld twee order nummers ingevuld maar in werkelijkheid kunnen dat er meerderen zijn Bekijk bijlage demo werkorder verplaatsen.xls

deze vraag al eerder geplaatst maar niet tot een goed einde gekomen, dus nog een poging

 

[HSV]

Zoiets?

Sub hsv()
Dim sn, sq, j As Long, i As Long, n As Long
With Sheets("werkorders")
sn = Sheets("basis").Columns(6).SpecialCells(2).Resize(, 18)
sq = .Columns(1).SpecialCells(2).Resize(, 14)
For j = 1 To 14 Step 3
  For i = 5 To UBound(sn)
    If sq(1, j) = sn(i, 15) Then
                   n = n + 1
          sn(n, 1) = sn(i, 1)
          sn(n, 2) = sn(i, 18)
    End If
  Next i
 If n > 0 Then .Cells(6, j).Resize(n, 2) = sn
    n = 0
Next j
End With
End Sub

 

[VenA]

Met een andere methode

Sub VenA()
Dim j As Long, ar
  With Sheets("Basis").Range("F5:W" & Cells(Rows.Count, 6).End(xlUp).Row)
    ar = .Value
    .SpecialCells(2).ClearContents
  End With
  With Sheets("werkorders")
    For j = 1 To UBound(ar)
      .Cells(Rows.Count, .Rows(4).Find(ar(j, 15)).Column).End(xlUp).Offset(1).Resize(, 2) = Array(ar(j, 1), ar(j, 18))
    Next j
  End With
End Sub

 

[ewh]

Bedankt voor de reaktie
HSV jouw code overschreef de gekopieerde data in dien er de wteede keer gekopieerd werdt

VenA , top heb alleen de regel '.SpecialCells(2).ClearContents uitgeschakeld , het was niet de bedoeling dat deze vba code het blad opschoonde

nogmaals beide bedankt voor de hulp

 

[HSV]

Kleine aanpassing voor de wat langer ogende, maar die vele malen sneller is dan die van @VenA (zeker bij meer data).

Sub hsv()
Dim sn, sq, j As Long, i As Long, n As Long
With Sheets("werkorders")
sn = Sheets("basis").Columns(6).SpecialCells(2).Resize(, 18)
sq = .Columns(1).SpecialCells(2).Resize(, 14)
For j = 1 To 14 Step 3
  For i = 5 To UBound(sn)
    If sq(1, j) = sn(i, 15) Then
                   n = n + 1
          sn(n, 1) = sn(i, 1)
          sn(n, 2) = sn(i, 18)
    End If
  Next i
[COLOR=#0000ff] If n > 0 Then .Cells(rows.count, j).end(xlup).offset(1).Resize(n, 2) = sn[/COLOR]
    n = 0
Next j
End With
End Sub

 

[ewh]

bedankt

 

[VenA]

Wel een beetje onduidelijk dan

het was niet de bedoeling dat deze vba code het blad opschoonde

Als dat gebeurd is dan zal het blad Basis worden geschoond en de week er op weer worden gevuld

Wie gaat het blad dan opschonen? En hoe voorkom je dat iemand per abuis twee keer de macro uitvoert?

 

[ewh]

zo zie je maar weer communicatie is lastiger dan we denken. sorry

Als het blad basis gevuld wordt door andere VBA codes ( maar dat ter zijde , dan wordt het blad basis gecontroleerd en vervolgens zal de uitsplisting plaatst vinden met jouw code en daar na zal het tabblad opgeslagen worden in het archief . daar na mag hij geschoond worden.

Dus jou code is slecht een deel van het totaal.
maar alles werkt nu ( eindelijk ) zo als we het willen hebben .

 

[VenA]

maar alles werkt nu ( eindelijk ) zo als we het willen hebben .

Da's mooi:d

Waarom niet alles in 1 tabel met daarin de 'datum' , kostenplaats, betreft en totaal? Uit de tab 'werkorders' is nagenoeg geen informatie te halen.

 

[ewh]

VenA,

leuk mee gedacht, maar de 4500 nummers zijn werkordernummers en we willen weten wat de stand van zaken is zodat er geen budget overschrijding plaatst vindt

 

[VenA]

Dan kan je alles het beste overal neerzetten voor een goed overzicht.