returnere værdier fra flere excelark

Hvordan skal indtastningsarket organiseres - når andet varenr. indtastes - d.v.s. skal der kunne lagres flere varenr herpå?

Det er en anden funktion og andre point :)

Opgaven her handler om, at kunne trække informationerne fra dokumentet med 52 ark.

Beskrivelse nok??

javel...

har tænkt på at opgaven kan løses med lidt VBA - ok?
Beskrivelse er tilstrækkelig.

VBA-kode anbringes under særligt ark - kaldet system i model. De øvrige ark er benævnt 1, 2, 3 o.s.v. Hvis du vil se min mkodel - så send en mail - @-adresse under min profil.

Const systemArknavn = "System"
Dim systemArk As Worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo fejl
    If Target.Address = "$D$1" And Target <> "" And IsNumeric(Target) = True Then
        udførSøgning Target
    End If
   
    Exit Sub
   
fejl:
End Sub
Private Sub udførSøgning(vareNr)
Dim arkNr As Integer, antalRæk As Integer, ræk As Integer
Dim antal, pris
    Application.ScreenUpdating = False
   
    Set systemArk = ActiveWorkbook.Sheets(systemArknavn)
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        With ActiveWorkbook
            If .Sheets(arkNr).Name <> systemArknavn Then
                .Sheets(arkNr).Select
                antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
                For ræk = 1 To antalRæk
                    If .Sheets(arkNr).Range("A" & ræk) = vareNr Then
                        antal = ActiveSheet.Range("B" & ræk)
                        pris = ActiveSheet.Range("E" & ræk)
                        systemArk.Range("A" & ActiveSheet.Name) = antal
                        systemArk.Range("B" & ActiveSheet.Name) = pris
                    End If
                Next ræk
            End If
        End With
    Next arkNr
   
    systemArk.Select
End Sub

Jeg har ingen anelse om hvordan jeg bruger VBA? i Excel???

Du er velkommen til at sende filen. @-adresse under min profil - eller du kan sende en mail, så sender jeg min model.

Const systemNavn = "Sammentælling"
Const systemArknavn = "Sammentælling Uge"
Dim systemArk As Worksheet, resultatRæk, antalFundne As Long, flag As Boolean, arkNr As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo fejl
    If flag = False Then
        If InStr(Target.Address, ":") > 0 Then Exit Sub
   
        If Target.Row > 7 And Target <> "" Then
            If Target.Column = 1 Then
Rem Søg på VARENR
                resultatRæk = Target.Row
                udførSøgning Target, 1
            Else
                If Target.Column = 2 Then
Rem Søg på VARETEKST
                    resultatRæk = Target.Row
                    udførSøgning Target, 2
                End If
            End If
        End If
    End If
    Exit Sub
   
fejl:
    Stop
    x = antalFundne                                'test
    y = arkNr                                      '-"-
    Resume Next                                    '-"-
End Sub
Private Sub udførSøgning(søgEfter, søgeType As Byte)
Dim søgeKolonne As String
Dim antalRæk As Integer, ræk As Integer, ugeNr As Integer, arkNavn As String, lokalSøgEfter As String, arkListe As String
Dim antal, pris
On Error GoTo fejl

    Application.ScreenUpdating = False
   
    If søgeType = 1 Then
        søgeKolonne = "A"
    Else
        søgeKolonne = "D"
    End If
   
    flag = False
    antalFundne = 0
    arkListe = ""
   
    Set systemArk = ActiveWorkbook.Sheets(systemArknavn)
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        With ActiveWorkbook
            arkNavn = .Sheets(arkNr).Name
            If InStr(arkNavn, systemNavn) = 0 Then
                .Sheets(arkNr).Select
               
                ugeNr = Mid(ActiveSheet.Name, 5)
               
                antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
                For ræk = 11 To antalRæk
                    lokalSøgEfter = .ActiveSheet.Range(søgeKolonne & ræk)
                   
                    If LCase(Trim(lokalSøgEfter)) = CStr(LCase(søgEfter)) Then
                        antalFundne = antalFundne + 1
                        flag = True
                       
                        antal = ActiveSheet.Range("B" & ræk)
                        pris = ActiveSheet.Range("G" & ræk)
                        systemArk.Cells(resultatRæk, ugeNr * 2 + 1) = systemArk.Cells(resultatRæk, ugeNr * 2 + 1) + antal
                        systemArk.Cells(resultatRæk, ugeNr * 2 + 2) = pris
                       
                        arkListe = arkListe + CStr(ugeNr) + " "
                        flag = False
                    Else
                        If .ActiveSheet.Range("A" & ræk) = "" Then
                            Exit For
                        End If
                    End If
                Next ræk
            End If
        End With
    Next arkNr
   
'    MsgBox arkListe                                'test
   
    MsgBox "Antal fundne: " & CStr(antalFundne)
   
    systemArk.Select
    ActiveSheet.Columns.AutoFit
    Exit Sub
   
fejl:
    Stop
    Resume Next
End Sub