Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1328to1332
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

kopierten Bereich kennzeichnen

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

Anzeige
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

Anzeige
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

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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige