22. marts 2014 - 14:54Der er
3 kommentarer og 1 løsning
flyt række fra ark1 til ark 2 ved ændringer i en eller flere celler
Hej, Sidder og arbejder med en problemstilling i Excel.
Ved ændringer i en eller flere celler i en given række i ark1, skal hele rækken flyttes fra ark1 til ark 2 med en dato markering (dags dato)i den første frie kolonne i rækken på ark2.
Er nået frem til nedenstående kode, som er sat på ark1, men den flytter hele rækken, for hver celle jeg laver ændringer i. Dvs. ændrer jeg 2 celler i en række i ark1, flytter den rækken 2 gange til ark2.
Er det muligt at.
1. Rækken kun flyttes en gang uanset, hvor mange celler jeg laver ændringer i og at de ændrede celler skifter farve i ark2 2. at få lagt en datomarkering i den første frie kolonne i rækken på ark2.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:AV")) Is Nothing Then
Denne side indeholder artikler med forskellige perspektiver på Identity & Access Management i private og offentlige organisationer. Artiklerne behandler aktuelle IAM-emner og leveres af producenter, rådgivere og implementeringspartnere.
Jeg har sat en ny linje ind, den tjekker om du bliver i samme række, så den gemmer kun hvis du går til en anden række fra den celle du ændrer sidst.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Exit Sub ' NY Target.EntireRow.Copy Worksheets("Ark2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Hvis du ikke har farver i cellerne på ark 1, kan denne briges
Private Sub Worksheet_Change(ByVal Target As Range) Dim RW As Long If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Target.Interior.Color = vbGreen ' laver rettet celle grøn Exit Sub ' NY End If Target.Interior.Color = vbGreen ' laver sidste rettede celle grøn, indrn kopiering RW = Worksheets("Ark2").UsedRange.Rows.Count + 1 'row Target.EntireRow.Copy Worksheets("Ark2").Range("A" & RW) Worksheets("Ark2").Range("AW" & RW) = Now() ' sætter dato og klokken i kolonne AW Range(Cells(Target.Row, "A"), Cells(Target.Row, "AV")).Interior.ColorIndex = xlNone End If End Sub
Det er super - de virker begge to, men nr. 2 er simpelthen lige den jeg søger, da det så bliver muligt at se præcis, hvilke celler, der bliver rettet i ark1.
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.
