kopieren in geschlossene datei

Sub auslesen() Dim rngAct As Range Dim intRow As Integer, intCol As Integer 'Workbooks.Open FileName:="C:\Lab_FE\VBA\Reisebericht\DB.xls" 'Worksheets("auslesen").Activate With Worksheets("Tabelle2") If IsEmpty(.Cells(1, 1)) Then intRow = 1 Else intRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 End If For Each rngAct In Range("A1,C2,C6,E5,A6").Cells intCol = intCol + 1 rngAct.Copy .Cells(intRow, intCol) Next rngAct End With Application.CutCopyMode = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub auslesen() Dim rngAct As Range Dim lgRow As Long Dim wksZiel As Worksheet Dim wksQuell As Worksheet Set wksQuell = ThisWorkbook.Sheets("Quelltabelle") Workbooks.Open Filename:="C:\Lab_FE\VBA\Reisebericht\DB.xls" Set wksZiel = ActiveWorkbook.Sheets("Zieltabelle") With wksZiel If IsEmpty(.Cells(1, 1)) Then lgRow = 1 Else lgRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 End If For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells lgRow = lgRow + 1 .Cells(lgRow, 1) = rngAct Next rngAct End With ActiveWorkbook.Close savechanges:=True End Sub

Sub auslesen_1() Dim rngAct As Range Dim lgRow As Long Dim wksZiel As Worksheet Dim wksQuell As Worksheet Set wksQuell = ThisWorkbook.Sheets("tabelle1") 'Quelltabelle Workbooks.Open FileName:="C:\Lab_FE\VBA\Reisebericht\DB.xls" Set wksZiel = ActiveWorkbook.Sheets("tabelle1") 'Zieltabelle With wksZiel If IsEmpty(.Cells(1, 1)) Then lgRow = 1 Else lgRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 End If For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells lgRow = lgRow + 1 .Cells(lgRow, 1) = rngAct Next rngAct End With ActiveWorkbook.Close savechanges:=True End Sub

Sub auslesen() Dim rngAct As Range Dim iCol As Integer Dim wksZiel As Worksheet Dim wksQuell As Worksheet Set wksQuell = ThisWorkbook.Sheets("Quelltabelle") Workbooks.Open Filename:="C:\Lab_FE\VBA\Reisebericht\DB.xls" Set wksZiel = ActiveWorkbook.Sheets("Zieltabelle") With wksZiel If IsEmpty(.Cells(2, 1)) Then iCol = 0 Else iCol = .Cells(2, Columns.Count).End(xlToLeft).Column End If For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells iCol = iCol + 1 .Cells(2, iCol) = rngAct Next rngAct End With ActiveWorkbook.Close savechanges:=True End Sub

hallo Peter,

nun ist es jetzt doch samstag geworden. klappt leider noch nicht ganz.

das auslesen in eine zeile klappt bestens, aber beim AUSLESEN soll der ausgelesen RANGE in der 1. freien ZEILE der SPALTE A stehen.

mit Deinem CODE


Sub auslesen()
Dim rngAct As Range
Dim iCol As Integer
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
Set wksQuell = ThisWorkbook.Sheets("Quelltabelle")
Workbooks.Open Filename:="C:\Lab_FE\VBA\Reisebericht\DB.xls"
Set wksZiel = ActiveWorkbook.Sheets("Zieltabelle")
With wksZiel
If IsEmpty(.Cells(2, 1)) Then
iCol = 0
Else
iCol = .Cells(2, Columns.Count).End(xlToLeft).Column
End If
For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells
iCol = iCol + 1
.Cells(2, iCol) = rngAct
Next rngAct
End With
ActiveWorkbook.Close savechanges:=True
End Sub

wird ALLES nebeneinander geschrieben.

ich habe schon versucht das prob zu loesen. natuerlich gescheitert.


Sub auslesen()
Dim rngAct As Range
Dim irow As Integer
Dim iCol As Integer
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
Set wksQuell = ThisWorkbook.Sheets("quelle")
Workbooks.Open FileName:="C:\test\mappe1.xls"
Set wksZiel = ActiveWorkbook.Sheets("ziel")
With wksZiel
If IsEmpty(.Cells(2, 1)) Then
iCol = 0
Else
iCol = .Cells(2, Columns.Count).End(xlToLeft).Column
End If
For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells
irow = .Cells(2, Row.Count).End(xlDown).Row + 1
'irow = .Cells(2, Row.Count).End(xlDown).Row '= rngAct
Next rngAct
End With
ActiveWorkbook.Close savechanges:=True
End Sub

vielen dank fuer Deine hilfe.

gruss thomas

Sub auslesen() Dim rngAct As Range Dim iCol As Integer Dim lgrow As Long Dim wksZiel As Worksheet Dim wksQuell As Worksheet Set wksQuell = ThisWorkbook.Sheets("Quelltabelle") Workbooks.Open Filename:="C:\Lab_FE\VBA\Reisebericht\DB.xls" Set wksZiel = ActiveWorkbook.Sheets("Zieltabelle") With wksZiel lgrow = .Range("A65536").End(xlUp).Row + 1 iCol = 0 For Each rngAct In wksQuell.Range("A1,C2,C6,E5,A6").Cells iCol = iCol + 1 .Cells(lgrow, iCol) = rngAct Next rngAct End With ActiveWorkbook.Close savechanges:=True End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread