ich habe da wieder ein Problem, was ich nicht alleine lösen kann.
Folgende Ausgangslage:
Ich kopieren drei Spalten (1.Spalte: Schriftart Marlett, da steht ein a oder nichts drin, Spalte 2 und 3 Calibri; Teilenummer und Teilename)
das ist der Code dafür:
Sub Kopieren_TopX_Month()
Sheets("TopX by Month").Range("e24:e10000").Copy
Sheets("TopX Month").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("TopX by Month").Range("f24:f10000").Copy
Sheets("TopX Month").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("TopX by Month").Range("d24:d10000").Copy
Sheets("TopX Month").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Im nächsten Schritt wird die Tabelle aus der die Daten stammen aktualisiert, wobei immer neue Daten hinzu kommen. Damit die Zuordnung ob "a" oder "nicht a" für die Teilenummern nicht jedesmal wieder von Hand getätigt werden müssen, lassen ich über
ein weiteres Makro wieder eintragen, somit muss ich mir nur die neuen Daten anschauen.
Das ist der Code für das einfügen des "a"
Sub Finden_Status_TopX_Month()
Worksheets("TopX by Month").Select
Worksheets("TopX by Month").Unprotect Password:="XXX"
Sheets("TopX by Month").Range("d24").FormulaArray = "=VLOOKUP(RC[1],'TopX Month'!R[-22]C[-3]:R[ _
9976]C[-1],3,FALSE)"
Sheets("TopX by Month").Range("d24").AutoFill Destination:=Range("D24:D10000"), Type:= _
xlFillDefault
Range("D24:D10000").Select
End Sub
Bis hier funktioniert auch alles. Im nächsten Schritt sollen alle Datensätze die mit einem "a" gekennzeichnet sind kopiert werden. Das geschieht mit diesem Code:Sub Kopieren4()
With Sheets("TopX by Month")
.Unprotect Password:="XXX"
Dim z As Integer
Dim leer As Integer
Dim Target1 As Range
Dim Target2 As Range
Dim Target3 As Range
z = 24
Do
If .Cells(z, 5) "" Then 'Makro soll so lange laufen bis in Spalte 4 kein Eintrag _
mehr ist
leer = False
Else
leer = True
End If
If .Cells(z, 4).Value = "a" Then 'Wenn in Spalte 3 ein "a" dann sollen der Inhalt aus _
Spalte 4 und 5 kopiert werden
.Cells(z, 5).Copy
.Cells(z, 6).Copy
' Der Inhalt aus Spalte 4 und 5 sollen in die nächste freie _
Zelle im Arabeitsblatt "Test" kopiert werden 8Spalte 1 und 2)
Set Target1 = Sheets("TopX17").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 5).Copy Destination:=Target1
Set Target2 = Sheets("TopX17").Range("B65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 6).Copy Destination:=Target2
Set Target1 = Sheets("TopX18").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 5).Copy Destination:=Target1
Set Target2 = Sheets("TopX18").Range("B65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 6).Copy Destination:=Target2
Set Target1 = Sheets("TopX19").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 5).Copy Destination:=Target1
Set Target2 = Sheets("TopX19").Range("B65536").End(xlUp).Offset(1, 0)
Sheets("TopX by Month").Cells(z, 6).Copy Destination:=Target2
End If
z = z + 1
Loop Until leer = True
.Protect Password:="XXX"
End With
End Sub
An der Stelle " If .Cells(z, 4).Value = "a" Then " bekomm ich allerdings die Fehlermeldung: "Laufzeitfehler 13": Typen unverträglichkeit.Ich vermute mal das er das "a" nicht mehr als "a" erkennt. Weiß jetzt allerdings auch nicht wie ich das beheben kann.
Entweder muss man hier das genauer deklarieren, damit "a" auch "a" bleibt:
"Sheets("TopX by Month").Range("d24:d10000").Copy
Sheets("TopX Month").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
"
oder im nachhinein die Spalte noch mal entsprechend nach dem Kopiervorgang konvertieren.
Ist wahrscheinlich wieder nur eine Kleinigkeit.
Danke schon einmal
Gruß Markus