kopierten Bereich kennzeichnen

Forumthread: kopierten Bereich kennzeichnen

31.08.2013 09:47:13

Peter

Hallo,
ich möchte nach dem kopieren nur den eingefügten Bereich in Spalte 19 mit neu kennzeichnen. Da die Zieltabelle sehr viele Datensätze enthält, sollte dies auf die
schnellste Art geschehen.
Wer kann helfen?
https://www.herber.de/bbs/user/87105.xls
Danke im voraus
Peter

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: kopierten Bereich kennzeichnen

31.08.2013 09:58:12

Stefan
AW: kopierten Bereich kennzeichnen

31.08.2013 09:58:18

ransi
AW: kopierten Bereich kennzeichnen

31.08.2013 11:52:17

Erich
AW: vielen Dank

31.08.2013 12:17:24

Peter
Danke für Rückmeldung - neue Variante

31.08.2013 13:06:45

Erich

AW: kopierten Bereich kennzeichnen

31.08.2013 09:58:12

Stefan

Hallo Peter,
meinst Du so?

Sub kopierenTest()
Dim ShQ As Worksheet, ShZ As Worksheet, z As Integer
Dim lRow As Long, lastZ As Long
Set ShQ = Worksheets(1)
Set ShZ = Worksheets(2)
lRow = ShZ.Cells(65536, 1).End(xlUp).Row + 1
'   lastZ = ShZ.Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
ShQ.Range("A3:L15").Copy 'gleichbleibender Bereich
ShZ.Cells(lRow, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
lastZ = ShZ.Cells(ShZ.Rows.Count, 1).End(xlUp).Row 'ich würde es nicht auf 655356 beschrä _
nken, da ab Excel 2007 es mehr Zeilen gibt
ShZ.Cells(lRow, 19).Resize(lastZ - lRow + 1).Value = "neu"
'    ' Fehler: es soll --nur-- der kopierte Bereich mit "neu" gekennzeichnet werden
'     With ShZ
'      For z = 2 To lastZ
'        If .Cells(z, 4)  "" Then .Cells(z, 19).Value = "neu"
'      Next
'     End With
'Idee Peter Haserodt ohne Selektionsrahmen
ShZ.Range("a1").Copy
ShZ.Range("a1").PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Application.ScreenUpdating = True
Set ShQ = Nothing
Set ShZ = Nothing
End Sub

Gruß Stefan

AW: kopierten Bereich kennzeichnen

31.08.2013 09:58:18

ransi

Hallo Peter
Versuch mal so:

Option Explicit

Sub kopierenTest()
    Dim ShQ As Worksheet, ShZ As Worksheet, z As Integer
    Dim lRow As Long, lastZ As Long
    Dim rngToCopy As Range
    Set ShQ = Worksheets(1)
    Set ShZ = Worksheets(2)
    lRow = ShZ.Cells(65536, 1).End(xlUp).Row + 1
    lastZ = ShZ.Cells(65536, 1).End(xlUp).Row

    Application.ScreenUpdating = False
    Set rngToCopy = ShQ.Range("A3:L15") 'gleichbleibender Bereich
    rngToCopy.Copy
    With ShZ.Cells(lRow, 1)
        .PasteSpecial (xlPasteValuesAndNumberFormats)
        .Offset(0, 18).Resize(rngToCopy.Rows.Count, 1).Value = "neu"
    End With

    ' ' Fehler: es soll --nur-- der kopierte Bereich mit "neu" gekennzeichnet werden
    ' With ShZ
    ' For z = 2 To lastZ
    ' If .Cells(z, 4) <> "" Then .Cells(z, 19).Value = "neu"
    ' Next
    ' End With

    'Idee Peter Haserodt ohne Selektionsrahmen
    ShZ.Range("a1").Copy
    ShZ.Range("a1").PasteSpecial (xlPasteValuesAndNumberFormats)

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Set ShQ = Nothing
    Set ShZ = Nothing
End Sub

ransi

AW: kopierten Bereich kennzeichnen

31.08.2013 11:52:17

Erich

Hi Peter,
oder auch so:


Option Explicit
Sub kopierenTest2()
Dim ShQ As Worksheet, z As Integer, lRow As Long, rngQ As Range
Set ShQ = Worksheets(1)             ' Quellblatt
Set rngQ = ShQ.Range("A3:L12")      ' gleichbleibender Quellbereich
With Worksheets(2)                  ' Zielblatt
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    ' Zielzeile
'   Application.ScreenUpdating = False    ' nach dem Test aktivieren?
rngQ.Copy
.Cells(lRow, 1).PasteSpecial xlPasteValuesAndNumberFormats
.Cells(lRow, 19).Resize(rngQ.Rows.Count) = "neu"
'Idee Peter Haserodt ohne Selektionsrahmen
With .Cells(lRow + rngQ.Rows.Count, 1)    ' nächste leere Zeile
.Copy
.PasteSpecial xlPasteValues
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: vielen Dank

31.08.2013 12:17:24

Peter

Vielen Dank Euch allen.
Jetzt komme ich ein großes Stück weiter.
Peter

Danke für Rückmeldung - neue Variante

31.08.2013 13:06:45

Erich

Hi Peter,
danke für deine Rückmeldung!
So gehts auch noch mit etwas weniger Code:


Option Explicit
Sub kopierenTest3()
Dim lRow As Long, rngQ As Range
' Application.ScreenUpdating = False    ' nach dem Test aktivieren?
Set rngQ = Worksheets(1).Range("A3:L12")              ' Quellbereich
With Worksheets(2)                                    ' Zielblatt
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    ' Zielzeile
rngQ.Copy
.Cells(lRow, 1).PasteSpecial xlPasteValuesAndNumberFormats
.Cells(lRow, 19).Resize(rngQ.Rows.Count) = "neu"
'Idee Peter Haserodt ohne Selektionsrahmen
With .Cells(lRow + rngQ.Rows.Count, 1)    ' nächste leere Zeile
.Copy
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End With
Application.ScreenUpdating = True
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

Forumthread: kopierten Bereich kennzeichnen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread