Jeg forestiller mig at Scriptet løber alle faner igennem. Hver gang det finder "a" i kolonne A, kopierer det hele rækken til et nyt ark og herefter overskriver "a" med fx. Ford. Næste fane medfører en ny række i det nye ark.
Her er lidt pseudokode:
For Each sheet
If "a" findes i kolonne A
Then Copy Række indeholdende "a" Paste Række indeholdende "a" til nederste tomme Række på Nyt Ark
Copy Celle A2 Paste Celle A2 til første celle i samme førnævnte række
Const samleArkNavn = "Resultat" '<---- evt. justeres Const ræk1Res = 5 Dim antalArk As Integer, antalRæk As Long, arkNavn As String, rækNr As Long, resultatRæk As Integer, bM As String Public Sub samlingAfArk() Application.ScreenUpdating = False
Rem hent ledige række i ResultatArk Sheets(samleArkNavn).Activate resultatRæk = ActiveCell.SpecialCells(xlLastCell).Row + 1
For Each ark In ActiveWorkbook.Sheets If InStr(ark.Name, samleArkNavn) = 0 Then ark.Activate antalRæk = ActiveCell.SpecialCells(xlLastCell).Row arkNavn = ark.Name bM = ark.Range("A1")
For rækNr = 5 To antalRæk With ActiveSheet If .Range("A" & rækNr) = "a" Then .Rows(rækNr & ":" & rækNr).Select Selection.Copy Sheets(samleArkNavn).Select ActiveSheet.Range("A" & resultatRæk).Select ActiveSheet.Paste Application.CutCopyMode = False
ActiveSheet.Range("A" & resultatRæk) = bM Exit For End If End With Next rækNr
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.
