AW: Code gesucht
05.08.2003 21:47:46
WernerB.
Hallo Reto,
was hältst Du hiervon?
Sub Reto()
Dim laR As Long
Application.ScreenUpdating = False
With Sheets("Tabelle1")
If .Range("A4").Value <> "" And IsNumeric(.Range("A4").Value) Then
laR = Sheets("Tabelle10").Cells(Rows.Count, 1).End(xlUp).Row
If laR < 3 Then laR = 3
.Rows("4:4").Copy
Sheets("Tabelle10").Range("A" & laR + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If .Range("A12").Value <> "" And IsNumeric(.Range("A12").Value) Then
laR = Sheets("Tabelle10").Cells(Rows.Count, 1).End(xlUp).Row
If laR < 3 Then laR = 3
.Rows("12:12").Copy
Sheets("Tabelle10").Range("A" & laR + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
End With
With Sheets("Tabelle2")
If .Range("A4").Value <> "" And IsNumeric(.Range("A4").Value) Then
laR = Sheets("Tabelle10").Cells(Rows.Count, 1).End(xlUp).Row
If laR < 3 Then laR = 3
.Rows("4:4").Copy
Sheets("Tabelle10").Range("A" & laR + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If .Range("A12").Value <> "" And IsNumeric(.Range("A12").Value) Then
laR = Sheets("Tabelle10").Cells(Rows.Count, 1).End(xlUp).Row
If laR < 3 Then laR = 3
.Rows("12:12").Copy
Sheets("Tabelle10").Range("A" & laR + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
Viel Erfolg wünscht
WernerB.