Hovedproblemet ser ut til å være at du ikke aktiverer de gjeldene arbeidsarkene og cellene. (Se linje 18 og 29)
Øvrig så inkrementeres
lastRowKombinert med en dersom noe blir lagt inn i kombinert arket.
Ellers har jeg ikke gjort noen andre endringer.
God jul!
Det gikk litt fort i svingene der. Jeg ser nå at flere av radene dukker opp dobbelt i kombinert arket. Det er nok fordi scriptet sjekker både for kolonne E og F hver for seg.
Har nå endret range (linje 25) til å kun ta for seg kolonne E, og sjekker dermed E og F i samme slengen. Da ungår du duplikater dersom det er fyllt inn noe i begge kolonnene.
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
'Aktiver gjeldene ark
sht.Activate
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:E100")
For Each cell In rng
'Aktiver gjeldene celle
cell.Activate
If cell.Value <> "" Or cell.Next <> "" Then 'Sjekker om celler i kolonne E eller F IKKE er tomme
ActiveCell.EntireRow.Copy Sheets("Kombinert").Range("A" & lastRowKombinert)
'Øk siste rad med 1
lastRowKombinert = lastRowKombinert + 1
End If
Next cell
Next sht
Application.ScreenUpdating = True
End Sub
Sist endret av NAPse; 24. desember 2019 kl. 15:49.
Grunn: Automatisk sammenslåing med etterfølgende innlegg.