AW: Kennzeichnen und Kopieren
04.11.2006 15:59:24
fcs
Hallo Dietmar,
folgendes Makro Starten nachdem die 1er in Spalte E eingetragen sind.
ggf. i Makro noch die Namen der Tabellen anpassen
Gruss
Franz
Sub Wertekopieren()
Dim wksTOP As Worksheet, wksKopie As Worksheet, ZeileTOP As Long, Zeile As Long
Dim SpalteTOP As Integer
Set wksTOP = ActiveWorkbook.Worksheets("TOP") ' Zieltabelle
Set wksKopie = ActiveWorkbook.Worksheets("Tab1") 'Tabelle mit werten, die kopiert werden sollen
ZeileTOP = 2 '1. Zeile in TOP in die eingetragen werden soll
SpalteTOP = 1 'Spalte in TOP ab der eingefügt werden soll
'Alte daten in TOP löschen
With wksTOP
.Range(.Cells(ZeileTOP, SpalteTOP), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, _
SpalteTOP + 2)).ClearContents
End With
'Werte aus Zellen B-D kopieren, wenn Wert in Spalte E = 1
For Zeile = 1 To wksKopie.Cells(wksKopie.Rows.Count, "E").End(xlUp).Row
If wksKopie.Cells(Zeile, "E").Value = 1 Then
wksKopie.Cells(Zeile, "E").Offset(0, -3).Range("A1:C1").Copy
wksTOP.Cells(ZeileTOP, SpalteTOP).PasteSpecial Paste:=xlValues
ZeileTOP = ZeileTOP + 1
End If
Next Zeile
Application.CutCopyMode = False
End Sub