cut to other sheet

[Geminite]

Hoi helpers,

Na verwoede pogingen ben ik vastgelopen met mijn projectje om VB te leren.

Onderstaande macro zou het volgende moeten doen;

Indien in colom H Yes (sheet DATA) is ingevuld, de hele rij knippen en plakken naar sheet COMPLETED, daarna de lege kolom verwijderen.

Echter hij kopieer wat 2 kolomen lager staat en tot overmaat van ramp blijft hij plakken op row 2

For Each c In Range("DATA!H2:H300")
If c.Value = "Yes" Then


Worksheets("DATA").Select
ActiveCell.EntireRow.Select
Selection.Cut
Sheets("COMPLETED").Select
Range("A" & Rows.Count).End(xlUp).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("DATA").Select
Selection.Delete Shift:=xlUp
ActiveCell.Select

End If

Next c

waar ben ik de mist ingegaan ?

Alvast bedankt

EDIT: Het plakken heb ik opgelost met:

Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select

Zoekende naar de verkeerde regel die word gekopieerd.

 

[snb]

1. vermijd select en activate
2. rijen zijn horizontaal (van links naar rechts, of andersom)
3. kolommen zijn vertikaal (van boven naar beneden, of andersom)

Sub weg()
  With Sheets("Data")
    For Each cl In .Range("H2:H300").specialcells(2)
      If cl = "Yes" Then 
        sheets("Completed").cells(rows.count).end(xlup).offset(1).entirerow=cl.entirerow
        cl.clearcontents
      End If
    Next
    .columns(8).specialcells(xlcelltypeblanks).entirerow.delete
  End With
End Sub

NB. Gebruik geen VBA-code die je niet begrijpt.

 

[Geminite]

Bedankt voor het snelle antwoord.

Op de suggestie om activate en select te vermijden begin ik opnieuw.. Helaas zal het wel eventjes duren .

 

[Geminite]

Voor wie de zoekmachine gebruiken, de oplossing die ik heb gebruikt (niet ideaal).

ipv vaste waarde in een cell (van de kolom), een waarde.

In de sheet zelf (MS Excel Objects):

Private Sub Worksheet_Change(ByVal Target As Range)

' "X" is kolom
'Worksheets("archief") = copy naar sheet.
If Left(Target.AddressLocal(ColumnAbsolute:=False), 1) = "X" Then
legeregel = Worksheets("archief").Range("A" & Rows.Count).End(xlUp).Row + 1
Rows(Target.Row).Copy Worksheets("archief").Rows(legeregel)
Rows(Target.Row).Delete shift:=xlUp
End If

End Sub

Suggesties altijd welkom en helpers bedankt