Hive data ud af en celle i mange ark

Det tror jeg godt vi kan finde ud af.
Er der plads til at oprette et nyt ark i din bestående fil?
Vender tilbage......

Her er et bud - indlægges i ThisWorkbook:

Const fpArkNavn = "FejlProcent"
Dim række
Sub UdtrækAfFejl()
Rem Test om arket "FejlProcent" findes - ellers opret dette
    If FindesFejlProcentArk = False Then
        opretFejlProcentArk
    End If
   
Rem Gennemløb de øvrige ark
    udtrækFejlProcent
   
Rem Juster kolonnebredden
    ActiveWorkbook.Sheets(fpArkNavn).Columns.AutoFit
   
    MsgBox ("Antal ark behandlet: " + CStr(række - 2))
End Sub
Private Sub udtrækFejlProcent()
Dim fProcent, dato
    række = 2
    antalArk = 0
   
    With ActiveWorkbook
        For Each sh In Sheets
            If sh.Name <> fpArkNavn Then
                fProcent = sh.Cells(5, 2)
                dato = sh.Cells(1, 17)
               
                With .Sheets(fpArkNavn)
                    .Cells(række, 1) = dato
                    .Cells(række, 2) = fProcent
                End With
                række = række + 1
            End If
        Next sh
   
    End With
End Sub
Private Sub opretFejlProcentArk()
    With ActiveWorkbook
        .Sheets.Add
        .Sheets(1).Name = fpArkNavn
        .ActiveSheet.Cells(1, 1) = "Dato"
        .ActiveSheet.Cells(1, 2) = "Fejlprocent"
    End With
End Sub
Private Function FindesFejlProcentArk()
    With ActiveWorkbook
        For Each sh In .Sheets
                If sh.Name = fpArkNavn Then
                    FindesFejlProcentArk = True
                    Exit Function
                End If
        Next sh
    End With
    FindesFejlProcentArk = False
End Function

Det er et kanon stykke arbejde du har lavet:-)

Forhøjer lige med 60 hvis du også kan få dit script til at sortere den liste der bliver genereret i modsat rækkefølge. Altså med den nyeste dato nederst.
Så passer det nemlig ind i nogle af de ark jeg bruger som henter data fra dette ark:-)
Evt, findes der er funktion i Excel der kan spejlvende data?

Men allerede nu så kører det jo bare...

Da jeg i fremtiden kommer til at ligge mange af jobbets funktioner ind i div. Excel-ark bliver jeg jo nød til at sætte mig ned og læse et par bøger omkring VB og Excel. Er der nogle du kan anbefale?

//Beach

Hvis arkene ligger i datoorden med nyeste til venstre - så er det blot at gennemløbe rækkefølgen af ark fra højre. Det prøver jeg - ellers kan der udføres en sortering.

Der er masser af hjælp i Excel - VBA men et godt udgangspunk kan være at indspille en makro og derefter tage udgangspunkt deri - altså marker et udtryk og tryk F1.

Men der ligger også en del på nettet -prøv at søge.

Rem Version 2 - i faldende dato-orden
Rem =================================
Const fpArkNavn = "FejlProcent"
Dim række
Sub UdtrækAfFejl()
Rem Test om arket "FejlProcent" findes - ellers opret dette
    If FindesFejlProcentArk = False Then
        opretFejlProcentArk
    End If
   
Rem Gennemløb de øvrige ark
    udtrækFejlProcent
   
Rem Juster kolonnebredden
    ActiveWorkbook.Sheets(fpArkNavn).Columns.AutoFit
   
    MsgBox ("Antal ark behandlet: " + CStr(række - 2))
End Sub
Private Sub udtrækFejlProcent()
Dim fProcent, dato, antalArk, ark
    række = 2
    antalArk = 0
   
    With ActiveWorkbook
        antalArk = .Sheets.Count
        For ark = antalArk To 1 Step -1
          If Sheets(ark).Name <> fpArkNavn Then
                fProcent = Sheets(ark).Cells(5, 2)
                dato = Sheets(ark).Cells(1, 17)
               
                With .Sheets(fpArkNavn)
                    .Cells(række, 1) = dato
                    .Cells(række, 2) = fProcent
                End With
                række = række + 1
            End If
        Next ark
    End With
End Sub
Private Sub opretFejlProcentArk()
    With ActiveWorkbook
        .Sheets.Add
        .Sheets(1).Name = fpArkNavn
        .ActiveSheet.Cells(1, 1) = "Dato"
        .ActiveSheet.Cells(1, 2) = "Fejlprocent"
    End With
End Sub
Private Function FindesFejlProcentArk()
    With ActiveWorkbook
        For Each sh In .Sheets
                If sh.Name = fpArkNavn Then
                    FindesFejlProcentArk = True
                    Exit Function
                End If
        Next sh
    End With
    FindesFejlProcentArk = False
End Function

Sorry den sløve svartid. Det virker perfekt og du får lige et megatak for hjælpen:-)

//Beach

Selv tak...