Hei godtfolk!
Begynte på et skript som jeg trodde skulle være veldig enkelt, men jeg har prøvd mye forskjellig og får det ikke til å virke.
Jeg har mange regneark med data. Jeg ønsker å loope med gjennom alle disse arkene. Dersom celle i kolonne E eller F ikke er tom, skal hele raden kopieres til et ark kalt "Kombinert". Er det noen som ser hvorfor dette ikke virker?
Hadde dette fungert skulle ca. 20 rader vært kopiert til "Kombinert", men ingenting kopieres
Sånn ser regnearkene ut, og for dette arket skulle 6 linjer vært kopiert til "kombinert".
Begynte på et skript som jeg trodde skulle være veldig enkelt, men jeg har prøvd mye forskjellig og får det ikke til å virke.
Jeg har mange regneark med data. Jeg ønsker å loope med gjennom alle disse arkene. Dersom celle i kolonne E eller F ikke er tom, skal hele raden kopieres til et ark kalt "Kombinert". Er det noen som ser hvorfor dette ikke virker?
Hadde dette fungert skulle ca. 20 rader vært kopiert til "Kombinert", men ingenting kopieres
Kode
Sub kombinerArk() Dim wrk As Workbook Dim sht As Worksheet Dim rng As Range, cell As Range Set wrk = ActiveWorkbook Application.ScreenUpdating = False Sheets("Kombinert").Move after:=Worksheets(Worksheets.Count) 'Gjør at "Kombinert" blir det siste arket lastRowKombinert = Sheets("Kombinert").Range("A" & Rows.Count).End(xlUp).Row + 1 'Starter loop For Each sht In wrk.Worksheets If sht.Index = wrk.Worksheets.Count Then 'Gjør at løkke stoppes når man kommer til det siste arket (Kombinert) Exit For End If Set rng = ActiveSheet.Range("E3:F100") For Each cell In rng If cell.Value <> "" Then 'Sjekker om celler i kolonne E eller F IKKE er tomme ActiveCell.EntireRow.Copy Sheets("Kombinert").Range("A" & lastRowKombinert) End If Next cell Next sht Application.ScreenUpdating = True End Sub
Sånn ser regnearkene ut, og for dette arket skulle 6 linjer vært kopiert til "kombinert".