• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

rij knippen en plakken

Status
Niet open voor verdere reacties.

Wallo

Gebruiker
Lid geworden
17 mrt 2009
Berichten
63
Hallo iedereen,
Wie kan mij hieruit helpen?
De onderste macro werkt perfect maar inplaats dat hij in blad "pat nr" een bestaande (ingevulde) rij eerst wist en dan de andere gegevens plakt en zo verder bouwt, wil ik dat hij doet wat in deze macro staat

Sheets("pat nr").Select
Rows("3:3").Select
Selection.Insert Shift:=xlDown

met andere woorden, hij moet de bestaande rijen naar beneden duwen, de rij erboven die dan vrij komt daar moet hij de nieuwe gegevens plakken.


Sub rijknippen()
On Error Resume Next
Do
With Sheets("patlijst nieuw").Columns(1).Find([B1], , xlValues, xlWhole).EntireRow
.Copy Sheets("pat nr").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Delete
End With
Loop Until Err.Number > 0
End Sub

Alvast bedankt Wallo:o:o:o
 
Hallo Wallo,

Bedoel je dit?
Code:
Sub Invoegen()
    Sheets("pat nr").Rows(3).Insert
End Sub
Met vr gr
Jack
 
Code:
Sub test()
  On Error Resume Next
  Do
  With Sheets("patlijst nieuw").Columns(1).Find([B1], , xlValues, xlWhole).EntireRow
       Sheets("pat nr").Rows(3).Insert Shift:=xlDown
       .Copy Sheets("pat nr").Cells(3, 1)
       .Delete
     End With
  Loop Until Err.Number > 0
   Sheets("pat nr").Rows(3).EntireRow.Delete
End Sub
 
Laatst bewerkt:
Bedankt alle twee het werkt:thumb::thumb::thumb:,
ik heb de macro nog wat uitgebreid daardoor zit ik met het volgende probleem, de macro werkt maar op werkblad "overzicht machine toekennen" kopieerd hij de rij tweemaal inplaats van éénmaal, wat heb ik verkeerd gedaan?:o
Alvast bedankt!

Sub rijknippen()
On Error Resume Next
Do
With Sheets("patlijst nieuw").Columns(1).Find([B1], , xlValues, xlWhole).EntireRow
Sheets("pat nr").Rows(3).Insert Shift:=xlDown
.Copy Sheets("pat nr").Cells(3, 1)
.Copy Sheets("blad1").Cells(3, 1)
.Delete
Sheets("overzicht machine toekennen").Select
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Sheets("machine toekennen").Select
Range("a100:u100").Select
Selection.Copy
Range("a1").Select
Sheets("overzicht machine toekennen").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("patlijst nieuw").Select
Range("B1").Select
End With
Loop Until Err.Number > 0
Sheets("pat nr").Rows(3).EntireRow.Delete
End Sub
 
Code:
Sub rijknippen()
On Error Resume Next
Do
With Sheets("patlijst nieuw").Columns(1).Find([B1], , xlValues, xlWhole).EntireRow
    Sheets("pat nr").Rows(3).Insert xlDown
    .Copy Sheets("pat nr").Cells(3, 1)
    '.Copy Sheets("blad1").Cells(3, 1)
    .Delete
End With
With Sheets("overzicht machine toekennen")
    .Rows(3).Insert Shift:=xlDown
    Sheets("machine toekennen").[A100:U100].Copy
    .[A3].PasteSpecial xlValues
End With
Loop Until Err.Number > 0
Sheets("pat nr").Rows(3).EntireRow.Delete
Sheets("overzicht machine toekennen").Rows(3).EntireRow.Delete
End Sub
 
Dag Warme bakkertje,
Bedankt voor de weer zeer snelle reactie en vereenvoudiging van de macro, eerst werkte hij niet volledig maar dan zag ik een klein foutje, namelijk het aanhalingstekentje voor Copy sheets zoals je hier onder kan zien, na het verwijderen van dit werkt hij perfect waarvoor mijn hartelijke dank.

'.Copy Sheets("blad1").Cells(3, 1)
Groetjes Wallo:D:thumb::thumb::thumb:
 
Mijn excuses, dit was nog een overblijfsel van mijn test waar ik over gekeken had.:o
 
Code:
Sheets("pat nr").Rows(3).EntireRow.Delete
Sheets("overzicht machine toekennen").Rows(3).EntireRow.Delete
bevat overbodige code:

Code:
Sheets("pat nr").Rows(3).Delete
Sheets("overzicht machine toekennen").Rows(3).Delete
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan