Udbygning af Public Sub CopyVerySpecial()

Jeg kan ikke rigtigt få de to spm. til at hænge sammen, men her er et skud.
Drejer det sig kun om B1 eller er det alle celler i kolonne B, du vil have flyttet ?

hvis det er alle celle i kol b så prøv den her
Public Sub CopyVerySpecial()
    Dim rKolB As Range
    Dim rCell As Range
   
    Set rKolB = Range("B1", Cells(65536, 2).End(xlUp))
    For Each rCell In rKolB
      rCell.Offset(0, 8 + rCell.Value) = rCell.Value
    Next rCell
   
    Set rCell = Nothing
End Sub

hvis det kun er B1 så prøv den her
Public Sub CopyVerySpecial2()
    Range("B1").Offset(0, 8 + Range("B1").Value) = Range("B1").Value
End Sub

Måske kan denne gøre det:

Public Sub CopyVerySpecial()
    Dim rCell As Range
    Dim iColNo As Integer
   
    iColNo = 10 + ActiveSheet.Range("b1").Value
 
    For Each rCell In Range(Cells(1, iColNo), Cells(25, iColNo))
        If rCell.Value = "" Then
            rCell.Value = ActiveSheet.Range("A1").Value
            Exit For
        End If
    Next rCell
 
    Set rCell = Nothing
End Sub

Ja, ja jan, ser godt ud :-)

Hov
For Each rCell In Range(Cells(1, iColNo), Cells(25, iColNo))
skal være
For Each rCell In Range(Cells(1, iColNo), Cells(65536, iColNo))

Jeg forstår heller ikke helt .....
Skal den ikke indsætte værdier i hele området?
Så skal du fjerne "Exit For".

Tak bak :-)

Det første spørgsmål lød:
Jeg mangler en macro der flytter eller kopierer et tal fra f.eks. A1 til K1 således at hvis K1 er optaget skrives tallet i K2, hvis der står noget i K2 skrives tallet i K3 o.s.v.
Ps. Det skal være en macro.
Til dette fik jeg ovenstående macro der virker perfekt.

Nu skulle der så indbygges en lille feature der læser værdien i B1 f.eks. 1,2,3 og ud fra denne værdi skrives til cellerne 1= K1, 2= L1 3= M1 o.sv. men samtidig bibeholdes funktionen fra den første macro.

Håber det er forståeligt nu.

lige knap, hvis nu k1 er optaget, men b1 = 2, skal tallet fra A1 så skrives i L1 eller L2 ?

Ok, så skulle min også være ok :-)

..... eller med andre ord: Den finder den første ledige celle i kolonne K,L el. M (afhængig af B1) og indsætter værdien fra A1.

Hvis der skrives 5 i A1 og der står 1 i B1, skal der skrives 5 i K1 hvis der står noget i forvejen skal der skrives i K2, hvis der også står noget der skrives i K3 o.s.v.
Hvis der står 2 i B1 skal der skrives 5 i L1 hvis der står noget skal der skrives i L2 o.s.v.
Hvis der står 3 i B1 skal der skrives 5 i M1 hvis der står noget skal der skrives i M2 o.s.v.

Fint, prøv så min kode :-)

Public Sub CopyVerySpecial()
    Dim rCell As Range
    Dim iColNo As Integer
   
    iColNo = 10 + ActiveSheet.Range("b1").Value
 
    For Each rCell In Range(Cells(1, iColNo), Cells(65536, iColNo))
        If rCell.Value = "" Then
            rCell.Value = ActiveSheet.Range("A1").Value
            Exit For
        End If
    Next rCell
 
    Set rCell = Nothing
End Sub

Jeg glemte lige at værdien i kolonne B er et tal mellem 1 og 30
således at vi starter ved K og går 30 felter til højre.

Tager koden også højde for .......
Kolonne J er default og så lægges værdien fra B1 til.
Er værdien i B4 = 6 ender vi i kolonne P.

Det er bare eminent, det virker perfekt, mange tak
Venlig hilsen Ejvind
http://www.verdensnavle.dk/

Undskyld
Er værdien i B1 = 6 ender vi i kolonne P.

Velbekomme :-)