AW: Insert nur nach Prüfung
13.12.2005 14:40:21
u_
Hallo,
Private Sub Export(code As String)
Dim t As Workbook
Dim d As Worksheet
Set t = ThisWorkbook
Set d = t.Worksheets("Grundwerte")
'd.Activate
'***Was soll das?***
' For i = 2 To 200
' If d.Cells(1, 1) = "PID" Then
' t.Worksheets("Januar 2005 - Juni 2005").Cells(14, 4) = d.Cells(5, 2)
' Exit For
' End If
' Next i
For i = 1 To 11
c = "not Defined"
Select Case i
Case 1: c = "AMR"
Case 2: c = "AMRS 1"
Case 3: c = "Sihlcity"
Case 4: c = "Legal"
Case 5: c = "AMDR"
Case 6: c = "AMRP"
Case 7: c = "AMRA"
Case 8: c = "AMRD"
Case 9: c = "AMRO"
Case 10: c = "AMRF"
Case 11: c = "AMRS"
End Select
If c <> "not Defined" Then
With t.Worksheets("Januar 2005 - Juni 2005")
Start = .Columns(1).Find _
(what:=c, after:=.Range("A1"), lookat:=xlWhole).Row + 1
End With
For j = 2 To d.Cells(65536, 1).End(xlUp).Row
If d.Cells(j, 4) = c Then
If WorksheetFunction.CountIf(t.Worksheets("Januar 2005 - Juni 2005").Columns(1), d.Cells(j, 5)) = 0 Then
With t.Worksheets("Januar 2005 - Juni 2005")
.Rows(Start).Insert Shift:=xlDown
.Rows(Start).Font.Bold = False
.Cells(Start, 1) = d.Cells(j, 5)
End With
Start = Start + 1
End If
End If
Next j
End If
Next i
Dim oData As DataObject
Set oData = New DataObject
oData.SetText ""
oData.PutInClipboard
End Sub
Gruß
Geist ist geil!