Zeile kopieren, wenn in Spalte bestimmter Wert steht
18.09.2023 10:28:48
Daniel
ich habe bei einem Makro folgendes Anliegen:
Aus einer Textdatei werden Daten importiert und entsprechend aufbereitet. Alle Teile, die in einer Spalte das Wort "Laserteil" enthalten, werden in einem anderem Blatt eingetragen.
Da ich den Sortiervorgang gerne erleichtern will, würde ich gerne das Makro erweitern.
Es soll nicht nur der Reiter "Laserteil" sondern noch weitere Reiter, wie z.B. "Laserteil Edelstahl" erzeugt und mit den Daten gefüllt werden, die den entsprechenden Betreff enthalten.
Zur Erklärung:
Tabelle1 = Arbeitsblatt, in den alle Informationen aus dem txt.-file importiert werden
Tabelle3 = Laserteile
Mein Problem: Sobald ich in der Zeile "For i = 1 To LetzteZeile
If Left(Cells(i, 10), 9) = "Laserteil" Then"
das Wort "Laserteil" durch "Laserteil Edelstahl" ersetze, wird der Reiter nicht gefüllt. (Zeile steht ungefähr in der Mitte des Codes).
Da ich leider keine VBA-Kenntnisse habe und da Makro von einem ehemaligen Kollegen erstellt wurde, würde ich gerne eure Hilfe in Anspruch nehmen.
Vielen Dank schon und Gruß
Daniel
Anbei der Code, der verwendet wird:
Sub H_Laserteile()
'erst mal alles löschen
Tabelle3.Select
Dim letztezeilem As Long
Dim letztespaltem As Long
Dim SortierWertG As String
Dim SortierWertC As String
Dim EndwertSortierung As String
Dim strTab3b As String
Dim strTab3Zeichensatz As String
' letztezeilem = Sheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row
' letztespaltem = Cells(13, Columns.Count).End(xlToLeft).Column
letztezeilem = 1000
letztespaltem = 13
Range(Cells(25, 1), Cells(letztezeilem, letztespaltem)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range(Cells(25, 1), Cells(letztezeilem, letztespaltem)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False
Selection.RowHeight = 15
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.Size = 11
End With
Selection.ClearContents
Dim LetzteZeile As Integer
Dim i As Integer
Dim j As Integer
Dim Abmasse() As String
Dim LetzterWert As String
Dim strverzinkt() As String
Dim strGewichtRechnen As String
j = 25
Tabelle1.Select
LetzteZeile = Worksheets.Application.Max(Range("A:A")) + 1
For i = 1 To LetzteZeile
If Left(Cells(i, 10), 9) = "Laserteil" Then
Tabelle3.Cells(j, 2) = Tabelle1.Cells(i, 3).Value
Tabelle3.Columns("C:C").NumberFormat = "@"
Tabelle3.Cells(j, 3) = Tabelle1.Cells(i, 6).Value
Tabelle3.Cells(j, 4) = Tabelle1.Cells(i, 9).Value
Tabelle3.Cells(j, 5) = Tabelle1.Cells(i, 10).Value
Tabelle3.Cells(j, 6) = "Bl."
Abmasse = Split(Cells(i, 11), " x ")
Tabelle3.Cells(j, 7) = WorksheetFunction.Substitute(Abmasse(0), ".", ",") * 1
Tabelle3.Cells(j, 8) = WorksheetFunction.Substitute(Abmasse(1), ".", ",") * 1
Tabelle3.Cells(j, 9) = WorksheetFunction.Substitute(Abmasse(2), ".", ",") * 1
Tabelle3.Cells(j, 10).FormulaLocal = "=(G" & j & "*H" & j & "*I" & j & ")*7,85/1000000"
Tabelle3.Cells(j, 11).FormulaLocal = "=(G" & j & "*H" & j & "*I" & j & ")*7,85/1000000*B" & j
Tabelle3.Cells(j, 12).FormulaLocal = "=WENN(UND(G" & j & "=K$11;(UND(ODER(H" & j & ">3000;I" & j & ">1500);ODER(H" & j & ">1500;I" & j & ">3000))));L$11*J" & j & ";0)+WENN(UND(G" & j & "=K$12;(UND(ODER(H" & j & ">3000;I" & j & ">1500);ODER(H" & j & ">1500;I" & j & ">3000))));L$12*J" & j & ";0)+WENN(UND(G" & j & "=K$9;ODER(UND(H" & j & "=3000;I" & j & "=1500);UND(H" & j & "=1500;I" & j & "=3000)));L$9*J" & j & ";0)+WENN(UND(G" & j & ">=K$10;ODER(UND(H" & j & "=3000;I" & j & "=1500);UND(H" & j & "=1500;I" & j & "=3000)));L$10*J" & j & ";0)"
Tabelle3.Cells(j, 13).FormulaLocal = "=WENN(UND(G" & j & "=K$11;(UND(ODER(H" & j & ">3000;I" & j & ">1500);ODER(H" & j & ">1500;I" & j & ">3000))));L$11*K" & j & ";0)+WENN(UND(G" & j & "=K$12;(UND(ODER(H" & j & ">3000;I" & j & ">1500);ODER(H" & j & ">1500;I" & j & ">3000))));L$12*K" & j & ";0)+WENN(UND(G" & j & "=K$9;ODER(UND(H" & j & "=3000;I" & j & "=1500);UND(H" & j & "=1500;I" & j & "=3000)));L$9*K" & j & ";0)+WENN(UND(G" & j & ">=K$10;ODER(UND(H" & j & "=3000;I" & j & "=1500);UND(H" & j & "=1500;I" & j & "=3000)));L$10*K" & j & ";0)"
If Right(Tabelle1.Cells(i, 10), 8) = "verzinkt" Then
Tabelle3.Cells(j, 6) = "Bl. verzinkt"
End If
j = j + 1
End If
Next
Tabelle3.Select