Abfrage bei mehreren Sheets
21.10.2004 11:52:16
Davide
Ich habe ein File "Aufwand.xls" mit einem Sheet namens "Aufwand".
Ich habe ein anderes File (Daten.xls) mit 4 Sheets namens "SheetA","SheetB","SheetC","SheetD"..In jeder dieser 4 Sheets ist immer ein Range (A1:A5) mit Daten vorhanden.
Mein Ziel ist es, dass ich nach diesen Sheets abfragen kann..wenn z.b das SheetA gefunden wurde, sollte er den Inhalt des Sheets in die Datei Aufwand.xls im Sheet Aufwand kopieren.
Es sollte inetwa so laufen:
1.Öffnen des Files Aufwand.xls
2."If Sheet "SheetA" vorhanden then selektiere SheetA und kopiere den Rangeinhalt nach Aufwand in Range (A1:A5).
"If Sheet "SheetB" vorhanden then selektiere SheetB und kopiere den Rangeinhalt nach Aufwand in Range (A6:A10).
und so weiter
Mein Code sieht folgendermassen aus:
_________________________________________________________
Sub abfrage
Dim strName As String
Dim wkbNew As Workbook
strName = "C:\Daten.xls"
Workbooks.Open strName
Set wkbNew = ActiveWorkbook
Dim arbeitsmappe
For Each arbeitsmappe In wkbNew.Sheets
Select Case arbeitsmappe.Select
Case "SheetA"
Sheets("SheetA").Select
range("A1:A5").Select
Selection.Copy
Workbooks("Aufwand.xls").Activate
Worksheets("Sheet1").Select
range("A1:A5").Select
ActiveSheet.Paste Destination:=ActiveCell
'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
'False, Transpose:=False
Selection.ClearFormats
Application.CutCopyMode = False
Case "SheetB"
Sheets("SheetB").Select
range("A1:A5").Select
Selection.Copy
Workbooks("Aufwand.xls").Activate
Worksheets("Sheet1").Select
range("A6:A10").Select
Selection.Paste 'Special Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.ClearFormats
Application.CutCopyMode = False
End Select
wkbNew.Close SaveChanges:=True
Application.CutCopyMode = False
Set wkbNew = Nothing
Next
End Sub
________________________________________________________________
und natürlich die anderen Cases für die zwei anderen Sheets(C,D)
Gruss