Ich habe wiedermal ein Problem mit vba kopieren, bzw. nur Werte erkennen und mitnehmen. Ich habe, gem. angehängtem Excel-Beispiel, eine Datei mit verschiedenen Registern. Die Aufgabe ist, aus allen Registern zwischen "Start" und "Ende" Daten des Bereichs B23:C39; E23:E39; H23:39 in das Zielregister untereinander hinein zu kopieren. Ich habs mit vollgemden Script probiert:
Sub Baukonti()
'löschen von alten Daten
Range("a4:d100").Select
Selection.ClearContents
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'automat.Berechnung ausschalten
Application.Calculation = xlCalculationManual
Sheets("Start").Select
Do
ActiveSheet.Next.Activate
' Blatt merken
Dim strStartBlatt As String
strStartBlatt = ActiveSheet.Name
' kopieren und einfügen
Range("B23:c39").Select
Selection.Copy
Range("A1").Select
Sheets("Baukonti").Select
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' zurück zum Ursprungsregister
ActiveWorkbook.Worksheets(strStartBlatt).Activate
' kopieren und einfügen
Range("e23:e39").Select
Selection.Copy
Range("A1").Select
Sheets("Baukonti").Select
Range("c2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' zurück zum Ursprungsregister
ActiveWorkbook.Worksheets(strStartBlatt).Activate
' kopieren und einfügen
Range("h23:h39").Select
Selection.Copy
Range("A1").Select
Sheets("Baukonti").Select
Range("d2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' zurück zum Ursprungsregister
ActiveWorkbook.Worksheets(strStartBlatt).Activate
Loop Until ActiveSheet.Name = "Ende"
Range("A1").Select
Sheets("Baukonti").Select
Range("A1").Select
'automat.Berechnung einschalten
Application.Calculation = xlCalculationAutomatic
'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True
End Sub
Das Ganze funktioniert wunderbar, bis auf die Spalte H, da hier Formeln hinterlegt sind. Mit "Selection.End(xlDown).Select" geht er eben nicht bis zum letzen Wert sondern bis zum letzten kopierten Bereich. Meine Frage ist nun, wie kann ich entweder nur die Werte beim kopieren erkennen oder wie kann ich "Selection.End(xlDown).Select" umdefinieren, dass er nur bis zum letzten effektiven Wert nach unten geht?Vielen Dank für eure Hilfe!
Gruss
Sigi
https://www.herber.de/bbs/user/107662.xlsx