AW: kopierte Zellen farbig unterlegen
19.04.2005 13:02:37
Beni
Hallo Josef,
dieser Code sucht nach dem Wert z.B. "Vk-DK" und wenn vorhanden, wird nichts kopiert.
Welcher Wert darf nicht mehrmals vorkommen?
Gruss Beni
Sub kopieren()
Dim wks As Worksheet
Dim wksS As Worksheet
Dim rng As Range
Dim rngX As Range
Dim lnge As Long
Dim intC, m, s As Integer
Dim Wert As Variant
Set wksS = Sheets("Eingabemaske")
lnge = wksS.Range("B65536").End(xlUp).Row + 1 'erste freie Zeile
For Each wks In ThisWorkbook.Sheets
If wks.Name <> "Eingabemaske" Then
Set rng = wks.Range("G13, G33, G24, G29, G30, C45, G32")
Wert = wks.Range("G13")
Set c = wksS.Columns(2).Find(What:=Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
m = 0
s = 1
For Each rngX In rng
If rngX = c(1, s) Then
m = m + 1
s = s + 1
If m = 7 Then MsgBox "Wert ist schon vorhanden": Exit Sub
End If
Next
End If
intC = 2
For Each rngX In rng
rngX.Copy wksS.Cells(lnge, intC)
intC = intC + 1
If intC > 8 Then
intC = 3
lnge = lnge + 1
End If
Next
End If
Next
End Sub