Hallo Leute
Für das Kopieren von Daten aus einer Tabelle in einer anderen Tabelle habe ich ein Makro mit verschiedenen Abfragen. Dieses Makro läuft gut. Nur wenn in der ersten Tabelle der Begriff nicht gefunden wird ( da er einmal vorhanden und einmal nicht vorhanden sein kann)läuft das Makro nicht mehr.
Ich suche ein Code der sagt " wenn der Wert in der ersten Tabelle nicht gefunden wird dann gehe zu der nächsten Abfrage. Hier das Makro:
' Materialgruppe BSR1
Windows("ASEFA.xls").Activate
'öffne die Tabelle1 aus der Mappe ASFA
Sheets("Tabelle1").Select
Range("b:b").Select
Selection.Find(What:=Range("Tabelle1!IV1").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
'finde die Bezeichnung die in Tabelle1 in Spalte IV1 steht
ActiveCell.Offset(0, 3).Select
'und markiere 3 Spalten daneben den gefundsenen Wert
ActiveCell.Select
Selection.Copy
Windows("Datentabelle2.xls").Activate
Sheets("Prod G3").Select
Range("a:a").Select
Selection.Find(What:=Range("a2").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
ActiveCell.Select
'füge den gefundenen Wert 2 Spalten neben der ersten Spalte ein
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Anpassung des Makros an die einzelnen Materialgruppen.
'Materialgruppe BSR2
Windows("ASEFA.xls").Activate
'öffne die Tabelle1 aus der Mappe ASFA
Sheets("Tabelle1").Select
Range("b:b").Select
Selection.Find(What:=Range("Tabelle1!IV2").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
'finde die Bezeichnung die in Tabelle1 in Spalte IV2 steht
ActiveCell.Offset(0, 3).Select
'und markiere 3 Spalten daneben den gefundsenen Wert
ActiveCell.Select
Selection.Copy
Windows("Datentabelle2.xls").Activate
Sheets("Prod G3").Select
Range("a:a").Select
Selection.Find(What:=Range("a2").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
ActiveCell.Select
'füge den gefundenen Wert 2 Spalten neben der ersten Spalte ein
ActiveCell.Offset(0, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Anpassung des Makros an die einzelnen Materialgruppen.
'Materialgruppe BTR1
Windows("ASEFA.xls").Activate
'öffne die Tabelle1 aus der Mappe ASFA
Sheets("Tabelle1").Select
Range("b:b").Select
Selection.Find(What:=Range("Tabelle1!IV3").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
'finde die Bezeichnung die in Tabelle1 in Spalte IV2 steht
ActiveCell.Offset(0, 3).Select
'und markiere 3 Spalten daneben den gefundsenen Wert
ActiveCell.Select
Selection.Copy
Windows("Datentabelle2.xls").Activate
Sheets("Prod G3").Select
Range("a:a").Select
Selection.Find(What:=Range("a2").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
ActiveCell.Select
'füge den gefundenen Wert 2 Spalten neben der ersten Spalte ein
ActiveCell.Offset(0, .Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Anpassung des Makros an die einzelnen Materialgruppen.
'Materialgruppe NAR1
Windows("ASEFA.xls").Activate
On Error Resume Next
'öffne die Tabelle1 aus der Mappe ASFA
Sheets("Tabelle1").Select
Range("b:b").Select
Selection.Find(What:=Range("Tabelle1!IV4").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
'finde die Bezeichnung die in Tabelle1 in Spalte IV2 steht
ActiveCell.Offset(0, 3).Select
'und markiere 3 Spalten daneben den gefundsenen Wert
ActiveCell.Select
Selection.Copy
Windows("Datentabelle2.xls").Activate
Sheets("Prod G3").Select
Range("a:a").Select
Selection.Find(What:=Range("a2").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Activate
ActiveCell.Select
'füge den gefundenen Wert 2 Spalten neben der ersten Spalte ein
ActiveCell.Offset(0, 11).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Kann mir jemand helfen?
Gruß
Peter
|