inhoud verplaatsen zonder opmaak te veranderen

[longron]

Beste alle,

in bij geleverde voorbeeld staan 2 namen.
Ik wil de namen etc verplaatsen naar een andere rij maar de opmaak van de cel moet niet veranderen.
bij deze routine zit nog een stukje vba waarmee je de namen zoekt in de sheet die je wilt gebruiken/veplaatsen zonder de layout te veranderen.

thanks,

Ronald

 

[Jack Nouws]

Bedoel je zo?

Sub test() 
  With Range("B5").CurrentRegion.Offset(1)
    .Copy Range("B14")
    .ClearContents
  End With
End Sub

 

[longron]

Ja en nee.
hij copieert en plakt op de juiste plek.
hij neemt de opmaak mee maar dat is niet erg.
Maar hij neemt alles mee wat er staan, ook de record eronder.
Hij moet alleen de naam en gegevens erachter meenemen die ik middels een andere routine heb gevonden.
Even voor de duidelijkheid.
dus ik zoek op bv Klaas en dan moet hij alleen klaas verplaatsen
Is een database met ongeveer 100 namen.

groetjes
Ronald

 

[Jack Nouws]

Zo?

  With Range("B4:E4")
    .Copy Range("B14")
    .ClearContents
  End With

Of

  With Range("B4").Resize(, 4)
    .Copy Range("B14")
    .ClearContents
  End With

 

[longron]

daarmee kan het wel. alleen moet ik nu nog de cel waaruit hij de gegevens verplaatst zo maken dat hij de cel neemt die actief is.
dus iets met activecell

 

[Jack Nouws]

Zo dan

  With ActiveCell.Resize(, 4)
    .Copy Range("B14")
    .ClearContents
  End With

 

[longron]

yep. dat moet wel lukken.
en als ik bv de inhoud wil verplaatsen naar de eerst volgende lege cel?

 

[Jack Nouws]

zo bijvoorbeeld

  With ActiveCell.Resize(, 4)
    .Copy Cells(Rows.Count, 2).End(xlUp).Offset(1)
    .ClearContents
  End With

startpositie in dit voorbeeld vanaf Range("B14")

  lr = IIf(Range("B14") = "", 14, Cells(Rows.Count, 2).End(xlUp).Offset(1).Row)
  
  With ActiveCell.Resize(, 4)
    .Copy Cells(lr, 2)
    .ClearContents
  End With

 

[longron]

Ik heb hem toch nog anders moeten maken:

dim verplaats(9)
dim X,Y
 Range("A2").Select
    For x = 1 To 190
    If ActiveCell.value <> InvoegWerkN Then
    ActiveCell.Offset(1, 0).Range("A1").Select
    End If
    Next x
    Verplaats(1) = ActiveCell.value
    Verplaats(2) = ActiveCell.Offset(0, 1).Range("A1")  '. Select
    Verplaats(3) = ActiveCell.Offset(0, 2).Range("A1")  '. Select
    Verplaats(4) = ActiveCell.Offset(0, 3).Range("A1") '. Select
    Verplaats(5) = ActiveCell.Offset(0, 4).Range("A1") '. Select
    Verplaats(6) = ActiveCell.Offset(0, 5).Range("A1") '. Select
    Verplaats(7) = ActiveCell.Offset(0, 6).Range("A1") '. Select
    Verplaats(8) = ActiveCell.Offset(0, 7).Range("A1") '. Select
    Verplaats(9) = ActiveCell.Offset(0, 8).Range("A1") '. Select
    With ActiveCell.Resize(, 9)
    .ClearContents
    End With
    Range("A2").Select
    For x = 1 To 190
    If ActiveCell.value <> Kies_disciplineN Then
    ActiveCell.Offset(1, 0).Range("A1").Select
    z = z + 1
    End If
    Next x
    For Y = 1 To 190 - z
   If ActiveCell.value <> "" Then
   ActiveCell.Offset(1, 0).Range("A1").Select
   End If
  Next Y
  
   ActiveCell.value = Verplaats(1): ActiveCell.Offset(0, 1).Range("A1") = Verplaats(2): ActiveCell.Offset(0, 2).Range("A1") = Verplaats(3): _
   ActiveCell.Offset(0, 3).Range("A1") = Verplaats(4): ActiveCell.Offset(0, 4).Range("A1") = Verplaats(5): ActiveCell.Offset(0, 5).Range("A1") = Verplaats(6): _
   ActiveCell.Offset(0, 6).Range("A1") = Verplaats(7): ActiveCell.Offset(0, 6).Range("A1") = Verplaats(8): ActiveCell.Offset(0, 8).Range("A1") = Verplaats(9)

InvoegWerkN is de naam die wordt geselcteert uit de beschikbare namen.
disciplineN is de functie die iemand heeft.
Hij vraagt dus eerst wie je wilt verplaatsen en daarna naar welke functie
Er zijn 9 cellen achter elkaar die hij moet verplaatsen.

Zie je nog ergens verbetering? Hoor het graag.

Thanks,
Ronald

 

[Jack Nouws]

Volgens mij ben je met een filter beter af. maar zonder een actueel voorbeeld bestandje is t koffiedik kijken.