Hent af nyeste række i underliggende ark

Via VBA kan det lade sig gøre at overføre den sidste række fra hvert underark til hovedarket - uden brug af formler/sammenkædning.

Er det dette du vil?

Ja, det lyder helt rigtigt!

D.v.s. at hovedarket bliver overskrevet med "de sidste rækker"!
Hvad hedder "hovedarket"?

Forslag - koden kopieres til VBA/ThisWorkbook (Alt+F11):
Koden udføres, når filen åbnes.


Const hovedArkNavn = "hovedark"            'Tilpasses
Private Sub workbook_activate()
Dim hræk
    hræk = 1
   
    For Each ark In ActiveWorkbook.Sheets
        If LCase(ark.Name) <> hovedArkNavn Then
            ark.Activate
            antalræk = ActiveCell.SpecialCells(xlLastCell).Row
            antalKol = ActiveCell.SpecialCells(xlLastCell).Column
           
            For k = 1 To antalKol
                værdi = Cells(antalræk, k)
                ActiveWorkbook.Sheets(hovedArkNavn).Cells(hræk, k) = værdi
            Next k
            hræk = hræk + 1
        Else
            ark.Cells.Clear
        End If
    Next ark
   
    ActiveWorkbook.Sheets(hovedArkNavn).Activate
End Sub

Den giver et problem med denne linie:

ActiveWorkbook.Sheets(hovedArkNavn).Cells(hræk, k) = værdi

Det er i hovedarket jeg skal indsætte koden i ThisWorkbook, ikke?

Den siger 'Subscript out of range'

Hovedarkets navn - i min kode er det anført som: "hovedark" - evt. korriger dette i koden: Const hovedArkNavn = "hovedark"            'Tilpasses

Koden indlægges i ThisWorkBook - den nederste i VBA-strukturen - ses v/Alt+F11

--

Ellers send en mail til: pb@supertekst-it.dk - så sender jeg min test-model

Der er sendt en mail. Har smidt navnet på mit ark ind i "hovedark", og problemet er der stadig.

Const hovedArkFil = "hovedark.xls"                                                      'Tilpasses
Const kildeFilSti = "C:\Documents and Settings\pb\Skrivebord\2703FlytFraTil\"          'Fælles-Mappen Tilpasses
Dim kXLS As Object, hræk
Private Sub workbook_activate()
    hræk = 1

Rem sletter indhold i hovedarkFilen (Ark 1)
    ActiveWorkbook.Sheets(1).Cells.Clear
   
Rem gennemsøg "fælles-mappen"
    søgiMappen
   
Rem vis hovedarket
    ActiveWorkbook.Sheets(1).Activate
   
    MsgBox ("Overførsel er afsluttet")
End Sub
Private Sub søgiMappen()                            'Der søges efter filer i Kildefil-stien
Dim fs, f, f1, fc, s
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(kildeFilSti)
    Set fc = f.Files
    For Each f1 In fc
        If LCase(f1.Name) <> hovedArkFil Then      'HovedArk-filen medtages ikke
            gennemgåKildeFil f1.Name
        End If
    Next
End Sub
Private Sub gennemgåKildeFil(kfil)                  'data hentes fra ark1 i kildefil
Dim count
    On Error GoTo fejl                              'hvis fejl - lukkes object-filen
   
Rem Åbner kildefilen
    Set xls = CreateObject("Excel.application")
    With xls
        .Workbooks.Open kildeFilSti + kfil
   
        .Sheets(1).Activate
        antalræk = .ActiveCell.SpecialCells(xlLastCell).Row
        antalKol = .ActiveCell.SpecialCells(xlLastCell).Column
       
        count = 0
        For k = 1 To antalKol
            værdi = .Cells(antalræk, k)
            If værdi <> "" Then
                ActiveWorkbook.Sheets(1).Cells(hræk, k) = værdi
                count = count + 1
            End If
        Next k
        If count > 0 Then
            hræk = hræk + 1                    'optæl kun række hvis indhold overført(forhindre tomme celler)
        End If
    End With

fejl:
    xls.Quit
    Set xls = Nothing
End Sub