Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereich kopieren nach größer/kleiner Vergleich

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
Anzeige
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 

Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige