# VBA Excel Range einlesen und kopieren



## Gordan (27. April 2021)

Hallo zusammen,

ich habe folgende Anforderung:
nachdem ich ein Button ausgelöst habe, sollen die Zellen mit Inhalt aus einer bestimmten Range kopiert und in eine andere Tabelle eingefügt werden.
Wenn bereits Daten in der Spalte von der neuen Tabelle enthalten sind, sollen diese nicht überschrieben sondern die neuen Werte sollen direkt darunter geschrieben werden.  

Beispiel:

1) Button gedrückt
2) Range von Tabelle 1 A33 bis A44 prüfen, ob Zellen Werte haben
3) die Zellen mit Wert kopieren
4) Tabelle 2 in Spalte B unter den bereits vorhandenen Werten einfügen

Ich würde mich sehr freuen, wenn jemand helfen kann.

Vielen Dank.

Mit lieben Grüßen
Maria D.


----------



## Yaslaw (27. April 2021)

Wo hast du dabei probleme?
Excel hat dazu VBA-Funktionen
1) & 2) Google mal nach "Excel VBA select not empty rows"
3) Goggle nach "Excel VBA copy selected Rows"
4) Google nach "Excel VBA get last row" & "Excel VBA past row"


----------



## Gordan (28. April 2021)

Yaslaw hat gesagt.:


> Wo hast du dabei probleme?
> Excel hat dazu VBA-Funktionen
> 1) & 2) Google mal nach "Excel VBA select not empty rows"
> 3) Goggle nach "Excel VBA copy selected Rows"
> 4) Google nach "Excel VBA get last row" & "Excel VBA past row"


Danke für die Tipps, jetzt habe ich mal einen Ansatz 

Würde ich heute mal testen 

Mit freundlichen Grüßen


----------



## Yaslaw (28. April 2021)

Bei konkreten Fragen helfen wir gerne auch im Code weiter.


----------



## Gordan (28. April 2021)

Yaslaw hat gesagt.:


> Bei konkreten Fragen helfen wir gerne auch im Code weiter.


Danke für das Angebot. Es ist beim erstellen eines Posts anfangs schwer einen Code zu posten, wenn man keinen wirklichen Ansatz hat, wie das realisiert werden kann


----------



## Gordan (28. April 2021)

Yaslaw hat gesagt.:


> Bei konkreten Fragen helfen wir gerne auch im Code weiter.


Hallo,
ich komme einfach nicht weiter  und brauche eure Hilfe 

Aktuell funktioniert es, dass beim einfügen die Spalte nach dem letzten Wert geprüft wird und das kopierte darunter geschrieben wird.

Bei der nächsten Herausforderung scheitere ich und komme auf keine Lösung.

Ich möchte die Range A33 bis A43 nach werten durchsuchen, wenn ein Wert gefunden wurde, soll dann von der gleichen Zeile aus aus der Spalte A D E der Wert kopiert und in ein anderes Blatt eingefügt werden.

Da ich es nicht hinbekomme, habe ich das ganze erstmal mit jeweils einem festen Bezug getestet.



```
Dim WERT1 As Integer
Dim WERT2 As Integer
Dim WERT3 As String

Worksheets("Kopieren der Werte").Select
WERT1 = Range("A33")
WERT2 = Range("D33")
WERT3 = Range("E33")

Worksheets("Einfuegen der Werte").Select
Worksheets("Einfuegen der Werte").Range("C1").Select
If Worksheets("Einfuegen der Werte").Range("C1").Offset(1, 0) <> "" Then
  Cells(Rows.Count, 3).End(xlUp).Select                    
End If
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = WERT1
            ActiveCell.Offset(0, 4).Select
            ActiveCell.Value = WERT2
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = WERT3


End If
```

Vielen Dank für die Hilfe


----------



## Yaslaw (29. April 2021)

Kleiner Tipps vornweg:
Mit Select() muss man ganz selten arbeiten. Besser gleich mit Objektvariablen. Und ActiveCell oder ActiveSheet etc. sollte man auch aufpassen. Es wird dann auch klarer, was gemacht wird

Ich habe hier mal dein Code umgechrieben (ungetestet, da ich grad kein Excel offen habe)

```
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim nextTargetRow As Long

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Kopieren der Werte")
Set wsTarget = wb.Worksheets("Einfuegen der Werte")

nextTargetRow = wsTarget.Cells(wsTarget.Rows.Count, 3).End(xlUp)

wsTarget.Cell(nextTargetRow, 1).Value = wsSource.Range("A33")
wsTarget.Cell(nextTargetRow, 4).Value = wsSource.Range("D33")
wsTarget.Cell(nextTargetRow, 5).Value = wsSource.Range("E33")
```

Und etwa so kannst di A33 bis A43 durchsuchen

```
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim nextTargetRow As Long
Dim actSourceRow As Long

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Kopieren der Werte")
Set wsTarget = wb.Worksheets("Einfuegen der Werte")

nextTargetRow = wsTarget.Cells(wsTarget.Rows.Count, 3).End(xlUp)
For actSourceRow = 33 to 43
    If wsSource.Cell(actSourceRow, 1).Value = "<ERSETZEN DURCH GESUCHTEN WERT>" Then
        wsTarget.Cell(nextTargetRow, 1).Value = wsSource.Cell(actSourceRow, 1)
        wsTarget.Cell(nextTargetRow, 4).Value = wsSource.Cell(actSourceRow, 4)
        wsTarget.Cell(nextTargetRow, 5).Value = wsSource.Cell(actSourceRow, 5)
        nextTargetRow = nextTargetRow + 1
    End If
Next actSourceRow
```


----------



## Gordan (29. April 2021)

Yaslaw hat gesagt.:


> Kleiner Tipps vornweg:
> Mit Select() muss man ganz selten arbeiten. Besser gleich mit Objektvariablen. Und ActiveCell oder ActiveSheet etc. sollte man auch aufpassen. Es wird dann auch klarer, was gemacht wird
> 
> Ich habe hier mal dein Code umgechrieben (ungetestet, da ich grad kein Excel offen habe)
> ...


Hey,

vielen Dank für deinen Tipp.

Ich habe jetzt erstmal deine erste Verbesserung getestet und hier bekomme ich bei der Zeile wsTarget.Cell(nextTargetRow, 1).Value = wsSource.Range("A33") den Fehler "Fehler beim Kompilieren: Methode oder Datenobjekt nicht gefunden".

Vielen Dank nochmals


----------



## Yaslaw (29. April 2021)

Es heisst Cells und nicht Cell.
Wie gesagt, ich schrieb den Code blind - also ohne Excel...


----------



## Gordan (29. April 2021)

Hey 

das mit Cells hätte mir auch auffallen können -,-

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")

nextTargetRow = wsTarget.Cells(wsTarget.Rows.Count, 3).End(xlUp)

wsTarget.Cells(nextTargetRow, 1).Value = wsSource.Range("A33")
wsTarget.Cells(nextTargetRow, 4).Value = wsSource.Range("D33")
wsTarget.Cells(nextTargetRow, 5).Value = wsSource.Range("E33")

Ich habe es nun mit Cells angepasst, aber es wird nichts in die Ziel Zellen geschrieben.
Der Code läuft normal durch.

Es gibt auch beide Worksheets und die Werte sind alle gefüllt 

Vielen Dank für deine Zeit, Hilfe und Geduld


----------



## Yaslaw (29. April 2021)

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 (29. April 2021)

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 (30. April 2021)

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


----------



## Gordan (30. April 2021)

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 (30. April 2021)

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


----------

