VBA Hilfe für Anfänger

Sub transfer() Dim lgLast As Long 'erste freie Zeile finden lgLast = Sheets(2).Range("A65536").End(xlUp).Row + 1 'Tabelle2 Zelle(Zeile, Spalte)=Tabelle1 Zelle Zeile, Spalte) Sheets(2).Cells(lgLast, 1) = Sheets(1).Cells(5, 3) Sheets(2).Cells(lgLast, 2) = Sheets(1).Cells(1, 1) Sheets(2).Cells(lgLast, 3) = Sheets(1).Cells(1, 2) End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub transfer() Dim lgLast As Long Dim wbQ As Workbook ' Quellmappe Dim wbZ As Workbook ' Zielmappe Dim wsQ As Worksheet ' Quellblatt Dim wsZ As Worksheet ' Zielblatt Set wbQ = ThisWorkbook Set wsQ = wbQ.Worksheets(1) Set wbZ = Workbooks.Open(Filename:="C:\Anwender\Datenbank.xls") Set wsZ = wbZ.Worksheets(2) 'erste freie Zeile im Zielblatt finden lgLast = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row + 1 'Tabelle2 Zelle(Zeile, Spalte)=Tabelle1 Zelle Zeile, Spalte) wsZ.Cells(lgLast, 1) = wsQ.Cells(5, 3) wsZ.Cells(lgLast, 2) = wsQ.Cells(1, 1) wsZ.Cells(lgLast, 3) = wsQ.Cells(1, 2) wbZ.Save wbZ.Close End Sub

Sub Transfer() Dim lgLast As Long Dim wbZ As Workbook ' Zielmappe Dim wsQ As Worksheet ' Quellblatt Dim wsZ As Worksheet ' Zielblatt Set wsQ = ActiveSheet Set wbZ = Workbooks.Open(Filename:="C:\Herber\Datenbank.xls") Set wsZ = wbZ.Worksheets(2) 'erste freie Zeile im Zielblatt finden lgLast = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row + 1 'Tabelle2 Zelle(Zeile, Spalte)=Tabelle1 Zelle Zeile, Spalte) wsZ.Cells(lgLast, 1) = wsQ.Cells(5, 3) wsZ.Cells(lgLast, 2) = wsQ.Cells(1, 1) wsZ.Cells(lgLast, 3) = wsQ.Cells(1, 2) wbZ.Save wbZ.Close End Sub

Hallo Micha,
das könnte so aussehen:

Sub Transfer()
Dim lgLast As Long
Dim wbZ As Workbook  ' Zielmappe
Dim wsQ As Worksheet ' Quellblatt
Dim wsZ As Worksheet ' Zielblatt
Set wsQ = ActiveSheet
Set wbZ = Workbooks.Open(Filename:="C:\Herber\Datenbank.xls")
Set wsZ = wbZ.Worksheets(2)
'erste freie Zeile im Zielblatt finden
lgLast = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row + 1
'Tabelle2 Zelle(Zeile, Spalte)=Tabelle1 Zelle Zeile, Spalte)
wsZ.Cells(lgLast, 1) = wsQ.Cells(5, 3)
wsZ.Cells(lgLast, 2) = wsQ.Cells(1, 1)
wsZ.Cells(lgLast, 3) = wsQ.Cells(1, 2)
Set wsQ = wsQ.Parent.Worksheets(4)
wsZ.Cells(lgLast, 4) = wsQ.Range("B1")
wbZ.Save
wbZ.Close
End Sub

Die Zielposition für den Inhalt von B1 musst du ggf. noch festlegen. Ich habe es jetzt in Spalte D geschrieben.
Viele Grüße
Dieter

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread