Bereich kopieren nach größer/kleiner Vergleich

Forumthread: Bereich kopieren nach größer/kleiner Vergleich

21.07.2014 11:17:14

ThHe

Guten Tag zusammen,
einen Zellbereich zu kopieren ist ein schon häufig diskutiertes Thema, allerdings konnte ich nichts zu meinem speziellen Problem finden bzw. konnte vorhandenes nicht entsprechend abändern, da meine Kentnisse dafür leider nicht ausreichen.
Ich möchte aus einer Tabelle2 aus der Spalte B (ab Zeile 2) alle Zellen kopieren und in Tabelle1 einfügen (in Spalte C ab Zeile 20), welche >= D13 und Ich habe ein Makro in diesem Forum gefunden und es versucht abzuändern aber es funktioniert _
leider nicht:


Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Tabelle2").Select
If Not Intersect(Target, Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)) Is Nothing And    _
_
_
_
_
_
Target.Count = 1 Then
If ((Target >= "Tabelle1!D13") And (Target

Danke für jegliche Hilfe!!
Grüße

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bereich kopieren nach größer/kleiner Vergleich

21.07.2014 17:43:03

fcs

AW: Bereich kopieren nach größer/kleiner Vergleich

21.07.2014 17:43:03

fcs

Hallo ThHe,
die entsprechenden Makros unter Tabelle1 müssten wie folgt aussehen.
Die Liste in Tabelle1 an C20 wird neuerstellt, wenn man zur Tabelle1 wechselt, z.B. nach Änderungen in Tabelle2 oder wenn der Wert in einer der Zellen D13 oder E13 geändert wird.
Gruß
Franz

'Code unter Modul Tabelle1
Private Sub Worksheet_Activate()
Call copyDataTabelle2
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address
Case "$D$13", "$E$13"
Call copyDataTabelle2
Case Else
'do nothing
End Select
End Sub
Private Sub copyDataTabelle2()
Dim wksTab2 As Worksheet
Dim varU, varO
Dim Zeile_1 As Long, Zeile_2 As Long, StatusCalc As Long
Set wksTab2 = ActiveWorkbook.Worksheets("Tabelle2")
varU = Me.Range("D13").Value
varO = Me.Range("E13").Value
'Makrobremsen lösen
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'alte Einträge ab Zelle C20 löschen
With Me
Zeile_1 = .Cells(.Rows.Count, 3).End(xlUp).Row
If Zeile_1 >= 20 Then
.Range(.Cells(20, 3), .Cells(Zeile_1, 3)).Clear
End If
Zeile_1 = 19
End With
With wksTab2
Zeile_2 = .Cells(.Rows.Count, 2).End(xlUp).Row
For Zeile_2 = 2 To Zeile_2
With .Cells(Zeile_2, 2)
If .Value >= varU And .Value

Beliebteste Forumthreads (12 Monate)

Bereich kopieren nach größer/kleiner Vergleich

Forumthread: Bereich kopieren nach größer/kleiner Vergleich

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread