data zoeken in gesloten workbook en weeregevn in active sheet

Status
Niet open voor verdere reacties.
M

michelleblanc

Gebruiker
Lid geworden
24 aug 2016
Berichten
32
Hallo,
Ik zougegevens willen halen uit een gesloten excel file met tabel. De zoekcriterium is een getal welke ik invoer in inputbox.
Dit getal staat in kolom C in de gesloten excel. Er kunnen in meerdere lijnen datzelfde getal voorkomen
Bedoeling is dat de gegevens worden weergegeven in de active sheet, die overeenkomen met dat getal. De gegevens die ik wil weergeven zitten in kolom I van de gesloten excel file.
Met de VBA hieronder, krijg ik als resultaat de gegevens van de eerste lijn, welke overeenkomt met dat getal, niet de gegevens van de volgende lijnen...

Hoe pas ik onderstaande VBA aan?

<Option Explicit
Sub findData()
Dim Gcell As Range
Dim Txt$, MyPath$, MyWB$, MySheet$
Dim myValue As Integer
Txt = InputBox("Welke bestelling wilt u nacalculeren?")
MyPath = "S:\Groups\VPK Display Productie\02 Cacheren"
MyWB = "input cacheren 2016 def.xlsm"
MySheet = ActiveSheet.Name
On Error GoTo ErrorHandler
'Application.ScreenUpdating = False
Workbooks.Open Filename:=MyPath & MyWB
Set Gcell = ActiveSheet.Cells.Find(Txt)
With ThisWorkbook.ActiveSheet.Range("C2:C10")
.Value = "nummer"
.Offset(0, 1).Value = "manuren"
.Offset(1, 0).Value = Gcell.Value
myValue = Gcell.Offset(0, 6).Value
.Offset(1, 1).Value = myValue
.Columns.AutoFit
.Offset(1, 1).Columns.AutoFit
End With
ActiveWorkbook.Close savechanges:=False
'Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 1004
Range("A1:B2").ClearContents
'Application.ScreenUpdating = True
MsgBox "De excel " & MyWB & "kon niet gevonden worden"
Case 9, 91
ThisWorkbook.Sheets(MySheet).Range("C2:D2").ClearContents

'Application.ScreenUpdating = True
MsgBox "Dossiernummer " & Txt & "is niet gevonden."
Exit Sub
Case Else
Application.ScreenUpdating = True
Exit Sub
End Select



End Sub
>
 
Plaats die code eerst eens tussen codetags.
Daarnaast vergeet je net als vrijwel iedereen een \ te plaatsen tussen het pad en de naam van het document.
 
Laatst bewerkt:
Dag edmoor,

Boedoel je dit:

HTML: 
Option Explicit
Sub findData()
Dim Gcell As Range
Dim Txt$, MyPath$, MyWB$, MySheet$
Dim myValue As Integer
Txt = InputBox("Welke bestelling wilt u nacalculeren?")
MyPath = "S:\Groups\VPK Display Productie\02 Cacheren\"
MyWB = "input cacheren 2016 def.xlsm"
MySheet = ActiveSheet.Name
On Error GoTo ErrorHandler
'Application.ScreenUpdating = False
Workbooks.Open Filename:=MyPath & MyWB
Set Gcell = ActiveSheet.Cells.Find(Txt)
With ThisWorkbook.ActiveSheet.Range("C2:C10")
.Value = "nummer"
.Offset(0, 1).Value = "manuren"
.Offset(1, 0).Value = Gcell.Value
myValue = Gcell.Offset(0, 6).Value
.Offset(1, 1).Value = myValue
.Columns.AutoFit
.Offset(1, 1).Columns.AutoFit
End With
ActiveWorkbook.Close savechanges:=False
'Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 1004
Range("A1:B2").ClearContents
'Application.ScreenUpdating = True
MsgBox "De excel " & MyWB & "kon niet gevonden worden"
Case 9, 91
ThisWorkbook.Sheets(MySheet).Range("C2:D2").ClearContents

'Application.ScreenUpdating = True
MsgBox "Dossiernummer " & Txt & "is niet gevonden."
Exit Sub
Case Else
Application.ScreenUpdating = True
Exit Sub
End Select



End Sub


Michel
 
Ik bedoel dit:
Code: 
Sub findData()
    Dim Gcell As Range
    Dim Txt$, MyPath$, MyWB$, MySheet$
    Dim myValue As Integer
    
    Txt = InputBox("Welke bestelling wilt u nacalculeren?")
    MyPath = "S:\Groups\VPK Display Productie\02 Cacheren\"
    MyWB = "input cacheren 2016 def.xlsm"
    MySheet = ActiveSheet.Name
    
    On Error GoTo ErrorHandler
    'Application.ScreenUpdating = False
    Workbooks.Open Filename:=MyPath & MyWB
    Set Gcell = ActiveSheet.Cells.Find(Txt)
    With ThisWorkbook.ActiveSheet.Range("C2:C10")
        .Value = "nummer"
        .Offset(0, 1).Value = "manuren"
        .Offset(1, 0).Value = Gcell.Value
         myValue = Gcell.Offset(0, 6).Value
        .Offset(1, 1).Value = myValue
        .Columns.AutoFit
        .Offset(1, 1).Columns.AutoFit
    End With
    ActiveWorkbook.Close savechanges:=False
    'Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    Select Case Err.Number
        Case 1004
            Range("A1:B2").ClearContents
            'Application.ScreenUpdating = True
            MsgBox "De excel " & MyWB & "kon niet gevonden worden"
        Case 9, 91
            ThisWorkbook.Sheets(MySheet).Range("C2:D2").ClearContents
            'Application.ScreenUpdating = True
            MsgBox "Dossiernummer " & Txt & "is niet gevonden."
            Exit Sub
    End Select
    Application.ScreenUpdating = True
End Sub
Of heb je echt alles zo strak onder elkaar staan?
Maar een voorbeeld document zou wel handig zijn.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan