Linie Zeichnen
22.07.2017 15:58:29
richar
ich setze seit ein paar Tage auf eine Aufgabe und habe bis jetzt keine Lösung.
Ich möchte am ende meine Tabelle3 eine Linie setze und und neue werte reinschreiben. ich habe _ ein Code aber kommt fehler 1004. bitte kann jemand mir helfen. Der code habe ich von Gunter genommen(danke dafür)
Private Sub CommandButton1_Click()
Dim i As Integer
Dim k As Integer
Dim y As Integer
Dim letzteZeile As Integer
Dim sZeichen As String
Dim nr As String
letzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, 6).End(xlUp).Row
For x = 2 To letzteZeile
y = 0
nr = Worksheets("Tabelle1").Range("J" & x & ":J" & x)
sZeichen = Mid(nr, 5, 1)
If Cells(x, 7) = "1T" Then
y = Worksheets("Tabelle3").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle1").Range("F" & x & ":G" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("A" & y & ":B" & y)
Worksheets("Tabelle1").Range("J" & x & ":L" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("C" & y & ":E" & y)
If sZeichen = "7" Then
Worksheets("Tabelle3").Range("F" & y & ":F" & y) = "No"
Else
Worksheets("Tabelle3").Range("F" & y & ":F" & y) = "Yes"
End If
Else
If Cells(x, 7) = "8Z" Then
y = Worksheets("Tabelle3").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle1").Range("F" & x & ":G" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("A" & y & ":B" & y)
Worksheets("Tabelle1").Range("J" & x & ":L" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("C" & y & ":E" & y)
If sZeichen = "7" Then
Worksheets("Tabelle3").Range("F" & y & ":F" & y) = "No"
Else
Worksheets("Tabelle3").Range("F" & y & ":F" & x) = "Yes"
End If
Else
If Cells(x, 7) = "5G" Then
y = Worksheets("Tabelle4").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle1").Range("F" & x & ":G" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("A" & y & ":B" & y)
Worksheets("Tabelle1").Range("J" & x & ":L" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("C" & y & ":E" & y)
If sZeichen = "7" Then
Worksheets("Tabelle4").Range("F" & y & ":F" & y) = "No"
Else
Worksheets("Tabelle4").Range("F" & y & ":F" & y) = "Yes"
End If
Else
If Cells(x, 7) = "3K" Then
y = Worksheets("Tabelle4").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle1").Range("F" & x & ":G" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("A" & y & ":B" & y)
Worksheets("Tabelle1").Range("J" & x & ":L" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("C" & y & ":E" & y)
If sZeichen = "7" Then
Worksheets("Tabelle4").Range("F" & y & ":F" & y) = "No"
Else
Worksheets("Tabelle4").Range("F" & y & ":F" & y) = "Yes"
End If
End If
End If
End If
End If
Next
' ich möchte meine ligne ab hier aber kommt fehler
Worksheets("Tabelle3").Range("J" & x - 2 & ":L" & x - 2).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
Worksheets("Tabelle3").Range("J" & x - 2 & ":L" & x - 2).Borders(xlEdgeBottom).Weight = _
xlMedium
Cells(x, 2).Value = "Name haufigkeit"
Cells(x, 3).Value = "Anzahl Zeichnung gut"
Cells(x, 3).Value = "Anzahl Zeichnung schlecht"
End Sub
Ich bedanke mich
Gruß
Richar