09. juni 2011 - 14:31Der er
3 kommentarer og 1 løsning
Markering og posten overflyttes
Hej alle sammen
I et excel ark har jeg 2 ark - "igangværende" og "færdig".
I arket "igangværende" har jeg en kolonne, der hedder færdig, som ligger i kolonne B.
Jeg ønsker, at når jeg skriver x i denne kolonne går rækkens indhold automatisk over i arket "færdig".
Hvis det kan laves helt optimalt skal rækkerne i "igangværende" rykke sig sammen, så der ikke er tomme rækker.
FX. Jeg har igangværende data i række 9 til 50 (kolonne A til Z) i arket "igangværende". Nu er jeg færdig med mine data i række 15 - jeg skriver "X" i kolonne B og alle i rækkens data flyttes automatisk over i "færdig" arket og får en unik plads der. Samtidig rykker data´ene sammen, så jeg nu kun har data fra række 9 til 49.
I "færdig" arket skal mine data starte i række 9 og hver post skal have en unik plads (de må ikke overskrives).
Prøv om nedenstående kode ligner noget du kan bruge ?
Kopier den ind i Change hændelsen på arket Igangværende via VBA editoren (alt + F11)
Når der tastes et lille x i en celle i kolonne B, kopieres cellerne i den aktive række fra og med kolonne C til og med kolonne Z.
Efterfølgende indsættes den kopierede række fortløbende ind i arket Færdig, startende fra række 9 celle A.
Og slutteligt slettes den kopierede række på arket Igangværende.
OBS: Koden fungerer i Excel 2003 ;o)
--------
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Integer 'variabel til rækkenummer Dim t As Range 'område variabel til den række der kopieres
'hvis den aktive celle er i kolonne B og værdien i cellen er x (læs: lille x) If Target.Column = "2" And Target.Value = "x" Then
Application.ScreenUpdating = False
'set t lig med hele den aktive række på arket "Igangværende" Set t = Target.EntireRow
'kopier cellerne fra C til Z i den aktive række Range("C" & Target.Row, "Z" & Target.Row).Copy
'gør Arket "Færdig" til det aktive ark Sheets("Færdig").Activate
'vælg celle "A9" på det aktive ark ActiveSheet.Range("A9").Select
'hvis den aktive celle er tom ... hvilket den er første gang der kopieres data til arket If ActiveCell.Value = "" Then
'indsæt det kopierede, startende fra den aktive celle ActiveCell.PasteSpecial xlPasteAll
'fjern kopimarkeringen fra arket "Igangværende" Application.CutCopyMode = False
'gør arket "Igangværende" til det aktive ark Sheets("Igangværende").Activate
'vælg celle "A1" på det aktive ark Range("A1").Select
Else
'tildel variablen r, rækkenummeret på sidste række i kolonne A på det aktive ark, som indeholder data r = ActiveSheet.Range("A5536").End(xlUp).Row
'vælg celle "A" i rækken efter sidste række indeholdende data ActiveSheet.Range("A" & r + 1).Select
'indsæt det kopierede, startende fra den aktive celle ActiveCell.PasteSpecial xlPasteAll
'fjern kopimarkeringen fra arket "Igangværende" Application.CutCopyMode = False
'gør arket "Igangværende" til det aktive ark Sheets("Igangværende").Activate
'vælg celle "A1" på det aktive ark Range("A1").Select
End If
'"sluk" for applikationshændelser Application.EnableEvents = False
'slet hele den kopierede række på arket "Igangværende" t.Delete
'"tænd" for applikationshændelser ud af drift Application.EnableEvents = True
Godt at høre det spiller for dig. Hermed et SVAR :o)
Med venlig hilsen, Nicolai
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
