Verplaatsen van regels tussen werkbladen

[gast0564]

Dag Helpmij,

Hopelijk kunnen jullie mij helpen met het volgende.

Op mijn afdeling is er 2 jaar geleden een exceltool opgezet door een oud collega die niet meer werkzaam is bij ons.
Deze exceltool zorgt er voor dat een excelbestand omgezet wordt in transportopdrachten voor onze vervoerder.

Dit waren er destijds 2, echter kunnen we tegenwoordig uit 16 verschillende vervoerders kiezen.

Nu probeer ik de tool hierop aan te passen, echter loop ik op het volgende vast.

Er bestaat binnen de tool de mogelijkheid om een opdracht van de ene transporteur naar de andere te verplaatsen.
Dit staat echter hard in de code, wat ook kon toen het een uitwisseling betrof tussen transporteur 1 en 2 en vice versa.

Nu is het zo dat ik vanuit 16 verschillende transporteurs naar 15 andere moet kunnen verplaatsen.
Oftewel: Hoe kan ik zorgen dat als ik in het tabblad van transporteur 1 t/m 16 sta de geselecteerde regels verplaats naar transporteur 1 t/m 16 welke dan onder de reeds bestaande regels toegevoegd moet worden?

Hopelijk is bovenstaande duidelijk genoeg icm onderstaande code

Sub MoveLineToBSYes()
'
' MoveLineToBSNoNo Macro
'

'

Application.ScreenUpdating = False
Sheets("Move to Transporteur1").Visible = False
Sheets("Transporteur1").Select
ActiveSheet.Unprotect
Range("I8:AR8").Select
Selection.AutoFilter
Selection.AutoFilter
Sheets("Transporteur2").Select
Set PrevCell = ActiveCell
ActiveSheet.Unprotect
Range("I8:AR8").Select
Selection.AutoFilter
Selection.AutoFilter
PrevCell.Select
ActiveSheet.Range(Cells(ActiveCell.Row, 9), Cells(ActiveCell.Row, 30)).Select
Selection.Copy
Sheets("Transporteur1").Select
Range("J5000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues


Range("AE5:AR5").Select
Selection.Copy
Range("AE9:AR2000").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("J1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Sheets("Transporteur2").Select
Selection.EntireRow.Delete
Range("AS5").Select
Selection.Copy
Range("AS9:AS2000").Select
ActiveSheet.Paste
Range("J1").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Application.ScreenUpdating = True

End Sub

 

[VenA]

Kan je even een voorbeeldje plaatsen. En ook graag code tussen codetags. Van de ene select naar de andere, een dubbele Selection.AutoFilter een .unprotect en een een .visible maakt het bijjna onmogelijk om er een antwoord op te geven.