samle kolonner

Hvis du kan bruge en VBA løsning

joeee. Det kan jeg måske godt, hvis den kan laves sådan, at det opdateres automatisk hvis der bliver indtastet nye navne i de nævnte kolonner på samme måde som arket ellers opdateres (enten automatisk eller F9).
Har bare ikke så meget styr på VBA, så du skal måske lige guide mig lidt. ;)

Højreklik på arkets fane,- vælg Vis programkode
indsæt følgende kode. koden forusætter de nævnte kolonner ikke er over 200 rækker
ellers skal den rettes til

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Or Target.Column = 10 Or Target.Column = 19 Or Target.Column = 28 Then
Dim t
Range("AD1:AD1000") = ""
For t = 1 To Cells(200, 2).End(xlUp).Row
If Cells(t, 2) <> "" Then Cells(Cells(1000, 30).End(xlUp).Row + 1, 30) = Cells(t, 2)
Next
For t = 1 To Cells(200, 10).End(xlUp).Row
If Cells(t, 10) <> "" Then Cells(Cells(1000, 30).End(xlUp).Row + 1, 30) = Cells(t, 10)
Next
For t = 1 To Cells(200, 19).End(xlUp).Row
If Cells(t, 19) <> "" Then Cells(Cells(1000, 30).End(xlUp).Row + 1, 30) = Cells(t, 19)
Next
For t = 1 To Cells(200, 28).End(xlUp).Row
If Cells(t, 28) <> "" Then Cells(Cells(1000, 30).End(xlUp).Row + 1, 30) = Cells(t, 28)
Next
End If
End Sub

hmmm jeg synes ikke rigtig, jeg kan få det til at virke. Jeg højreklikker på arket og vælger vis programkode og kopierer derefter koden ind og gemmer. Jeg prøver at opdatere arket, men ser ingen steder, at der sker noget. Hvilken kolonne vil den nye liste stå i? Jeg vil gerne have, at de nuværende kolonner med navne stadig er synlige. Den nye kolonne med alle navnene skal være i fanen "Ark 3", kolonne B fra linie 9 og nedefter. De nuværende navne står i førnævnte kolonner under fanearket "Kurslister". Jeg har forsøgt at indsætte koden i begge ark uden at det virker.
Har du en løsning?

listen skrives i kolonne AD

du skal indtaste noget i en af de 4 kolonner før der opdateres
du kan evt rette et af de bestående hvis du ikke lige har en ny

jeg retter lige koden til dine nye oplysninger

koden tester i række 1 til 200 i de 4 kolonner
hvor mange rækker kan der maks være værdier i ?
koden sletter B9:B1000 i ark3 inden værdier skrives igen
når du tilføjer en værdi i en af de 4 kolonner

dette skal muligvis rettes til så det passer til dine data

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Or Target.Column = 10 Or Target.Column = 19 Or Target.Column = 28 Then
Dim t, rw
Sheets("Ark3").Range("B9:B1000") = ""
For t = 1 To Cells(200, 2).End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, 2).End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, 2) <> "" Then Sheets("Ark3").Cells(rw, 2) = Cells(t, 2)
Next
For t = 1 To Cells(200, 10).End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, 2).End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, 10) <> "" Then Sheets("Ark3").Cells(rw, 2) = Cells(t, 10)
Next
For t = 1 To Cells(200, 19).End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, 2).End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, 19) <> "" Then Sheets("Ark3").Cells(rw, 2) = Cells(t, 19)
Next
For t = 1 To Cells(200, 28).End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, 2).End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, 28) <> "" Then Sheets("Ark3").Cells(rw, 2) = Cells(t, 28)
Next
End If
End Sub

Super. Nu ser det ud til at virke. Der kan være op mod ca 150 indtastninger i hver kolonne. Hvis jeg nu ændrer kolonner i Ark 3 hvad skal jeg så gøre for at rette koden til? Det kunne måske godt ende med at blive B, C, D og E i stedet for...
Smid endelig et svar.

du mener vel arket Kurslister ?

ja naturligvis.
Kan det evt. laves sådan, at der springes en linie over for hver ny kolonne, der overføres til kolonne B under ark 3?

hej igen. Der kommer også lige en 5. kolonne, men alle er med maks 150 indtastninger. Kan det også klares? På forhånd tak.

TESTER I KOLONNE B TIL F

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 And Target.Column < 7 Then
Dim t, rw
Sheets("Ark3").Range("B9:B1000") = ""
For t = 1 To Cells(200, "B").End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, "B") <> "" Then Sheets("Ark3").Cells(rw, "B") = Cells(t, "B")
Next
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: Sheets("Ark3").Cells(rw, "B") = " "
For t = 1 To Cells(200, "C").End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, "C") <> "" Then Sheets("Ark3").Cells(rw, "B") = Cells(t, "C")
Next
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: Sheets("Ark3").Cells(rw, "B") = " "
For t = 1 To Cells(200, "D").End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, "D") <> "" Then Sheets("Ark3").Cells(rw, "B") = Cells(t, "D")
Next
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: Sheets("Ark3").Cells(rw, "B") = " "
For t = 1 To Cells(200, "E").End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, "E") <> "" Then Sheets("Ark3").Cells(rw, "B") = Cells(t, "E")
Next
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: Sheets("Ark3").Cells(rw, "B") = " "
For t = 1 To Cells(200, "F").End(xlUp).Row
rw = Sheets("Ark3").Cells(1000, "B").End(xlUp).Row + 1: If rw < 9 Then rw = 9
If Cells(t, "F") <> "" Then Sheets("Ark3").Cells(rw, "B") = Cells(t, "F")
Next
End If
End Sub

*

Meget flot. Tak!

VELBEKOM :-)