SamleArk (oversigtsark) hente data fra andre ark

Må VBA (Visual Basic for Applications) anvendes?

Jeg kender slet ikke noget til VBA. Men hvis det er den eneste måde at løse det på, er jeg åben for det.
Bare man kan beholde nogle overskrifter, summere op og sætte det pæn op går det vel. Men ved ikke hvor meget man kan med VBA.

Er det altid kun området B6:O30, der skal overføres?
Tilføres nye data kun til samme område (B6:O30)?

Har du mulighed for at sende en lille model på f.eks. 2 ark - og samlearket.

(mailadresse under min profil)

jeg har lige sendt dig regnearket.

Det kan godt være der kommer flere rækker til området senere. Eller det er jeg faktisk sikker på der gør. Men maks. 50 rækker pr. ark.

Hej supertekst. Skal lige hører om du stadig har mulighed for at hjælpe?

Hej newbie

Sig frem - så kan jeg da tage stilling til det aktuelle..

Version 2:

Rem Version 2
Rem =========
Const arkAlleNavn = "Alle"
Const arkAlleFørsteRække = 12
Dim arkAlle As Worksheet
Dim aRække

Dim arkSort As Worksheet
Const arkSortFørsteRække = 6
Dim antalKolonner
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Sh.Name = arkAlleNavn And Target.Address = "$I$1" Then
        opdaterAlle
    End If
End Sub
Public Sub opdaterAlle()                                  'kan evt. forbindes med knap
    Set arkAlle = ActiveWorkbook.Sheets(arkAlleNavn)
   
    opdateringAfAlle
   
    sætTimeStamp
   
    arkAlle.Activate
    ActiveSheet.Cells(arkAlleFørsteRække, 2).Select
   
   
    MsgBox ("Arket Alle er opdateret")
End Sub
Private Sub opdateringAfAlle()
    Application.ScreenUpdating = False
   
    rydArkAlle
   
    overførArkSort
   
    Application.ScreenUpdating = True

End Sub
Private Sub rydArkAlle()
Dim række
    arkAlle.Activate
    antalKolonner = ActiveCell.SpecialCells(xlLastCell).Column
       
    For række = arkAlleFørsteRække To 65000
Rem Check om total-række er nået (kol. I har formel, men ikke kol. G & K)
        If Cells(række, 9).HasFormula = True And Cells(række, 7).HasFormula = False And Cells(række, 11).HasFormula = False Then
            Exit For
        Else
            For Each celle In Range(Cells(række, 2), Cells(række, antalKolonner))
                If celle.HasFormula = False Then
                    celle.Value = ""
                End If
            Next
        End If
    Next række
End Sub
Private Sub overførArkSort()
    aRække = arkAlleFørsteRække
   
    For Each arkSort In ActiveWorkbook.Sheets
        If arkSort.Name <> arkAlleNavn Then
            arkSort.Activate
            For række = arkSortFørsteRække To 65000
Rem Check om Total-rækken er nået
                If Cells(række, 9).HasFormula = True And Cells(række, 7).HasFormula = False And Cells(række, 11).HasFormula = False Then
                    Exit For
                Else
                    If Cells(række, 2) <> "" Then
                        For Each celle In Range(Cells(række, 2), Cells(række, antalKolonner))
                            If celle.HasFormula = False Then
                                arkAlle.Cells(aRække, celle.Column) = celle.Value
                            End If
                        Next
                        aRække = aRække + 1
                    End If
                End If
            Next række
        End If
    Next
End Sub
Private Sub sætTimeStamp()
    arkAlle.Activate
   
    ActiveSheet.Range("I2") = Now
End Sub

Hej supertekst. Det er bare rigtigt godt. Perfekt!! det virker bare rigtigt godt.

Mange tak for hjælpen.

Hej
Fint - tak og selv tak