Automatische Namengebung für Tabellen geht nicht
15.03.2005 10:13:33
urmel-online
ich habe u.s. (Makro1) geschrieben welches sich aus einer Tabelle den Namen und das Filterkriterium herauslesen soll und den gefilterten Inhalt dann in eine Tabelle mit dem entsprechenden Namen einfügt. Die Namen der Tabellen werden aber auch schon mit einem anderen Makro im Vorfeld gesetzt (Makro2), welches in den jeweiligen Tabellen enthalten ist. Wenn ich jetzt Makro1 ausführe, gibt es immer eine Fehlermeldung beim reinkopieren der selektierten Daten in die entsprechende Tabelle. Die Fehlermeldung kommt dann in Makro2. Überschreibe oder verändere ich dort vielleicht irgendwelche Parameter ? Ich hoffe mir kann jemand helfen oder einen anderen Lösungsvorschlag anbieten.
Danke schon mal vorab.....
MAKRO1:
Sub Kopieren_Tabelle1()
Sheets("Chart Project planning total").Select
Range("A2:H78").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data transfer").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim ws As String
Dim zeile1 As Integer
Dim zeile2 As Integer
Dim spalte1 As Integer
Dim spalte2 As Integer
Dim wname As String
ws = ""
wname = ""
Sheets("Chart Project planning total").Select
Range("P103").Select
zeile1 = ActiveCell.Row
spalte1 = ActiveCell.Column
ws = ActiveCell.Value
Range("I103").Select
zeile2 = ActiveCell.Row
spalte2 = ActiveCell.Column
wname = ActiveCell.Value
Sheets("Data transfer").Select
Selection.AutoFilter Field:=8, Criteria1:=wname
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(ws).Select
Range("A2:H41").Select
Selection.ClearContents
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2:H41").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub
MAKRO2:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("ca1")) Is Nothing Then
Range("ca2").Select
End If
If Target = Range("ca1") Then ActiveSheet.Name = Target
End Sub