gegevens wegschrijven

[tjeerdy]

goedemiddag,

Voor de afdeling transport ben ik bezig met een kleine optimalisatie.
Ik de bijlage zit de uitgeklede versie van onze planning.
In het tabblad planlijst maken onze planners de planning, deze wordt in de tabbladen Rit 1 t/m rit 8 gezocht.
Met een macro in het tabblad planlijst kunnen de lijsten worden afgedrukt. Ik ben echter op zoek naar het volgende:
Wanneer ik op de macro knop verwijderen klik, moeten de gegevens onder het kopje filiaal naar het blad overzicht ritten worden weggeschreven. Daarna gaan ze de volgende 8 ritten plannen, als er nu op verwijderen geklikt wordt, moeten deze naast de ritten van daarvoor gezet worden. de laaste lukt me echter nog niet...
Bekijk bijlage Planlijst + Ritlijst.xlsBekijk bijlage Planlijst + Ritlijst.xls

 

[tkint]

Beste,

Graag "ingevulde" tabbladen en een voorbeeld zoals het zou moeten.

 

[tjeerdy]

Bekijk bijlage Planlijst + Ritlijst.xlsHierbij de ingevulde tabbladen.

 

[tjeerdy]

Is het mogelijk hier samen naar te kijken?

 

[Cobbe]

Ja is goed, ik kijk van 8 tot 8:15.

 

[Cobbe]

Plak deze eens achter je Wegschrijvenbutton.

Sub Wegschrijven()
'
With Application
   .ScreenUpdating = False
   With Sheets("Planlijst")
    .Range("A5:A20,E5:E20,I5:I20,M5:M20").Copy
       Sheets("Overzicht ritten").Range("IV2").End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    .Range("A5:A20,E5:E20,I5:I20,M5:M20").ClearContents
    .Range("A24:A39,E24:E39,I24:I39,M24:M39").Copy
       Sheets("Overzicht ritten").Range("IV2").End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    .Range("H1:I1,B2:C2,F2:G2,J2:K2,N2:O2,B21:C21,F21:G21,J21:K21,N21:O21,A5:C19,E5:G19,I5:K19,M5:O19,A24:C38,E24:G38,I24:K38,M24:O38,A42:O48,D41:O41").ClearContents
   End With
  .ScreenUpdating = True
End With
End Sub

Wel nog de celopmaak verzorgen.

 

[Cobbe]

Nog beter is het gebruik van namen, voor elke auto één.

Sub Wegschrijven()
'
With Application
   .ScreenUpdating = False
   With Sheets("Planlijst")
    For i = 1 To 8
    .Range("auto" & i).Copy
       Sheets("Overzicht ritten").Range("IV2").End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    .Range("auto" & i).ClearContents
    Next
   End With
  .ScreenUpdating = True
End With
End Sub

Dan wel eerst een naambereik per auto maken.

 

[VenA]

Ook even gegekeken

Sub VenA()
With Sheets("Planlijst")
    For j = 1 To 8
        If j < 5 Then
            Sheets("Overzicht ritten").Cells(2, j).Resize(15, 1) = .Cells(5, 1).Offset(, (j - 1) * 4).Resize(15).Value
        Else
            Sheets("Overzicht ritten").Cells(2, j).Resize(15, 1) = .Cells(24, 1).Offset(, (j - 5) * 4).Resize(15).Value
        End If
    Next j
    .Range("A5:O19,A24:O38").SpecialCells(2).ClearContents
End With
End Sub