ich habe mit eurer Hilfe folgendes Makro zusammengebastelt:
Public Sub MachMal()
Dim strDatName As Variant
Dim wbA As Workbook, wbB As Workbook
Dim wsA As Worksheet, wsB As Worksheet
Dim iZeile As Long, letzteZeile As Long
Dim Suchnummer
' Dateinnamen definieren
strDatName = Application.GetOpenFilename("ExcelFiles (*.XLS), *.xls")
If strDatName False Then
Set wbB = Workbooks.Open(strDatName)
Set wbA = ThisWorkbook
Else
Exit Sub
End If
' Tabellennamen definieren
' ***** Die erste Tabelle der Datei A, ggf. anpassen! *****
Set wsA = wbA.Worksheets(1)
' Suche
For iZeile = 1 To wsA.Range("A65536").End(xlUp).Row
Suchnummer = wsA.Cells(iZeile, 1)
For Each wsB In wbB.Worksheets
letzteZeile = wsB.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(wsB.Range("A1:A" & letzteZeile), Suchnummer) > 0 Then
wsA.Cells(iZeile, 2) = wsB.Name
wsA.Cells(iZeile, 3) = Left(wbB.Name, Len(wbB.Name) - 4)
wsA.Cells(iZeile, 5) = WorksheetFunction.VLookup(Suchnummer, wsB.Range("A1:H" & _
letzteZeile), 8, 1)
wsA.Cells(iZeile, 6) = WorksheetFunction.VLookup(Suchnummer, wsB.Range("A1:K" & _
letzteZeile), 11, 1)
Exit For
End If
Next wsB
Next iZeile
' Datei B schliessen
wbB.Close
Application.ScreenUpdating = False
For Each rng In Range("A4:A499")
rng.EntireRow.Hidden = Application.CountA(rng.Resize(, 1)) = 0
Next
ActiveWorkbook.Save
End Sub
Bei der Ausführung erhalte ich den Fehler 400 ohne weitere Erläuterungen. Kann mir jemand helfen warum?Das oben genannte Makro steht in dieseArbeitsmappe. Ich würde zusätzlich noch gerne folgende Prozedur einbauen:
Dim i As Long
With Sheets("Tabelle2")
i = .Cells(1, 1).Value
Select Case i
Case 0
.Rows("4:40").Hidden = True
Case Else
.Rows("4:" & (3 + i)).Hidden = False
End Select
End With
End Sub
Leider wird dann aber immer falsch ausgeblendet.Viele Grüße Kai