Anzeige
Archiv - Navigation
1556to1560
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

Fehlersuche

Fehlersuche
19.05.2017 15:22:42
Marghescu
Hallo Zusammen,
Ich habe folgendes kleines Makro:
Sub ÜBERTRAG2()
' ÜBERTRAG2 Makro
Application.ScreenUpdating = False
Sheets("TAGESAUSWERTUNG").Select
Range("C7:G7").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("GESAMTAUSWERTUNG").Select
Range("B6").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Sheets("TAGESAUSWERTUNG").Select
Range("B7").Select
Sheets("TAGESAUSWERTUNG").Select
Range("B7").Select
Call LÖSCHEN
Application.ScreenUpdating = True
End Sub

Das Ding soll in der Tabelle TAGESAUSWERTUNG im Bereich C7:G7 nach unten bis zur letzten Zeile alles kopieren und dieses dann in der Tabelle GESAMTAUSWERTUNG in der ersten freien zelle der Spalte B ab frühestens B6 einfügen. Ich hatte das mit dem Makrorecorder aufgezeichnet, doch der Code hatte den Haken, nicht zur ersten freien Zeile ging sondern zu einer bestimmten zeile (B15) weil das beim aufzeichnen wohl grad so war. Ich habe dann versucht diese zeile einzufügen, aber das will nicht funktionieren:
ActiveCell.Offset(1, 0).Select
könnte da mal einer drüberschauen?
danke

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehlersuche
19.05.2017 15:50:09
ChrisL
Hi
Sub ÜBERTRAG2()
Application.ScreenUpdating = False
With Sheets("TAGESAUSWERTUNG")
.Range("C7:G" & .Cells(Rows.Count, 3).End(xlUp).Row).Copy
End With
With Sheets("GESAMTAUSWERTUNG")
If .Range("B6") = "" Then
.Range("B6").PasteSpecial xlValues
Else
.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlValues
End If
End With
'Call LÖSCHEN
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

cu
Chris
AW: Fehlersuche
19.05.2017 18:01:10
Marghescu
Vielen Dank schon mal. das geht schon im Ansatz, jedoch tritt noch folgendes Problem auf:
Beim ermitteln des zu kopierenden Bereichs werden anscheinend auch "leere Zellen" die Formeln enthalten als gefüllt erkannt. gibt es ein Argument hierfür welches nur die letzte befüllte zelle bei ignorierung von Formeln ermittelt
danke
Anzeige
AW: Fehlersuche
19.05.2017 18:10:31
ChrisL
Hi
Probier mal...
.Range("C7:G" & .Cells(Rows.Count, 3).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Copy
cu
Chris
AW: Fehlersuche
19.05.2017 19:03:01
Marghescu
Danke für die Mühe aber jetzt kommt keine zellen gefunden+
ich habe im netz noch folgendes gefunden kann es aber nicht anwenden
2. Determine the last used row in a worksheet (excluding formulas displaying blank cell)
The following macro returns the last used row number in worksheet "Sheet1". It includes rows with data or a formula displaying data. It ignores cells containing formulas displaying the empty string i.e. ="".
Sub lastusedrow1()
Dim last As Long
last = Worksheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
MsgBox "Last used row number in sheet1 is " & last
End Sub

kann man das so einschränken, dass die suche nur in einer spalte erfolgt und nicht in der ganzen tabell? der Hintergrund ist, dass in Spalte A Zeilennummern stehen und daher
die gefundene Zeilenzahl zu gross ist. Die Numerierung geht bis Zeile 30 aber es stehen eventuell nur 5 zu kopierende datensätze drin
verzwickt!
End Sub
Anzeige
AW: Wer lesen kann...
19.05.2017 19:58:21
Werner
Hallo,
du solltest schon alle Beiträge lesen. Genau mit dieser Methode habe ich dir vor geraumer Zeit schon einen Lösungsvorschlag geschickt.
Gruß Werner
AW: Fehlersuche
19.05.2017 18:35:50
Werner
Hallo,
z.B.: so:
Sub ÜBERTRAG2()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("TAGESAUSWERTUNG")
loLetzte = .Columns(3).Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Row
.Range("C7:G" & loLetzte).Copy
End With
With Sheets("GESAMTAUSWERTUNG")
If .Range("B6") = "" Then
.Range("B6").PasteSpecial xlValues
Else
.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlValues
End If
End With
'Call LÖSCHEN
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
AW: Fehlersuche
19.05.2017 16:15:50
UweD
Hallo
auf select kann in 99% verzichtet werden...
Sub ÜBERTRAG2()
    Dim LR1 As Double, LR2 As Double, RNG As Range
    
    Application.ScreenUpdating = False
    With Sheets("TAGESAUSWERTUNG")
        LR1 = .Range("C7:G7").End(xlDown).Row
        Set RNG = .Range("C7:G" & LR1)
    End With
    With Sheets("GESAMTAUSWERTUNG")
        LR2 = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        RNG.Copy
        .Range("B" & LR2).PasteSpecial xlValues
        Application.CutCopyMode = False
    
    End With
    Call LÖSCHEN
    
End Sub

LG UweD
Anzeige
Wie wäre es mit einer Rückmeldung?
23.05.2017 14:46:26
Werner
Hallo,
solange es noch nicht funktioniert kann man sich noch melden, dann aber wohl nicht mehr? Danke auch im Namen der anderen Helfer.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige