VBA Excel Range einlesen und kopieren

[Yaslaw]

So, habs mal mit Excel getestet.
Deine Version um die letzte Zeile zu ermitteln ist Schrott. Ok, am Ende hätte noch ein .Row angefügt werden müssen. Aber auch dann, gab sie bei einem leeren Sheet 1 heraus. Dabei sollte es 0 sein.

Function test()
    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim nextTargetRow As Long
    
    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("WS_A")
    Set wsTarget = wb.Worksheets("WS_B")
    
    nextTargetRow = xlsGetLastRow(wsTarget) + 1
    
    wsTarget.Cells(nextTargetRow, 1).Value = wsSource.Range("A33").Value
    wsTarget.Cells(nextTargetRow, 4).Value = wsSource.Range("D33")
    wsTarget.Cells(nextTargetRow, 5).Value = wsSource.Range("E33")
End Function

'/**
' * ermitteln der letzten gefüllten Zeile eines Worksheets
' * Die Funktion Sheet.Cells.SpecialCells(xlCellTypeLastCell) liefert auch instanzierte Zeilen ohne Inhalt
' * http://wiki.yaslaw.info/wikka/vbaExcelGetLastRowCol
' * @param  Worksheet               Eine Referenz auf das Worksheet
' * @return Long                    Zeilenindex der letzten Zeile mit Inhalt
' */
Public Function xlsGetLastRow(ByRef Sheet As Excel.Worksheet) As Long
    Dim r As Variant
 
    xlsGetLastRow = Sheet.Cells.SpecialCells(xlCellTypeLastCell).row
    For r = xlsGetLastRow To 1 Step -1
        If Sheet.Application.WorksheetFunction.CountA(Sheet.rows(r)) = 0 Then
            xlsGetLastRow = r - 1
        Else
            Exit For
        End If
    Next r
End Function

 

[Gordan]

Wie rufe ich mit einem Button diese Function auf?

Ich habe einen Button erstellt
Sub transfer_werte()
.
.
.
.
.
End Sub
Die Functions werden beim Debuggen nicht beachtet-,-

 

[Yaslaw]

meine Funktion test kann grad so gut eine Sub sein. SPrich den Code aus meiner Test() in deine transfer_werte() kopieren.

 

[Gordan]

Hallo,

ich habe deine Functions nun in meine Sub kopiert.
Beim Ausführen bekomme ich diesen Fehler:


Sub transfer_werte()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim nextTargetRow As Long
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Vorlage")
Set wsTarget = wb.Worksheets("Eingang & Ausgang")
wsTarget.Cells(nextTargetRow, 1).Value = wsSource.Range("A33")
wsTarget.Cells(nextTargetRow, 4).Value = wsSource.Range("D33")
wsTarget.Cells(nextTargetRow, 5).Value = wsSource.Range("E33")
Dim r As Variant
xlsGetLastRow = Sheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For r = xlsGetLastRow To 1 Step -1
If Sheet.Application.WorksheetFunction.CountA(Sheet.Rows(r)) = 0 Then
xlsGetLastRow = r - 1
Else
Exit For
End If
Next r
End Sub

Vielen Dank.

 

[Yaslaw]

Bitte in Zukunft wieder Code-Tags für Code verwenden. Macht das ganez lesbarer.

Du machst ein Chaos. Ich empfehle dir dich mal in die Grundlagen von VBA einzulusen.
EInfach zusammenkopieren ohne die Grundlagen ergibt fast immer Chaos.
Und ud kannst nicht einfach 2 Funktionen wild ineinander kopieren. Das ist total sinnlos und fliegt dir mit Recht um die Ohren.

Sub transfer_werte()
    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim nextTargetRow As Long
    
    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("WS_A")
    Set wsTarget = wb.Worksheets("WS_B")
    
    nextTargetRow = xlsGetLastRow(wsTarget) + 1
    
    wsTarget.Cells(nextTargetRow, 1).Value = wsSource.Range("A33")
    wsTarget.Cells(nextTargetRow, 4).Value = wsSource.Range("D33")
    wsTarget.Cells(nextTargetRow, 5).Value = wsSource.Range("E33")
End Sub

'/**
' * ermitteln der letzten gefüllten Zeile eines Worksheets
' * Die Funktion Sheet.Cells.SpecialCells(xlCellTypeLastCell) liefert auch instanzierte Zeilen ohne Inhalt
' * http://wiki.yaslaw.info/wikka/vbaExcelGetLastRowCol
' * @param  Worksheet               Eine Referenz auf das Worksheet
' * @return Long                    Zeilenindex der letzten Zeile mit Inhalt
' */
Public Function xlsGetLastRow(ByRef Sheet As Excel.Worksheet) As Long
    Dim r As Variant
 
    xlsGetLastRow = Sheet.Cells.SpecialCells(xlCellTypeLastCell).row
    For r = xlsGetLastRow To 1 Step -1
        If Sheet.Application.WorksheetFunction.CountA(Sheet.rows(r)) = 0 Then
            xlsGetLastRow = r - 1
        Else
            Exit For
        End If
    Next r
End Function