Kopieren von einer anderen Excel Datei

Sub Kopieren() Dim Wieder as Integer For Wieder = 1 To 300 If Cells(wieder, 1) = "DAT" Then _ Range (Cells(Wieder, 1), Cells(Wieder, 20)).copy _ Sheets("Blatt1").Cells(Sheets("Blatt1").Range("2000").End(xlUp).Offset(1, 0).Row, 1) Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
hier eine Lösungsmöglichkeit. Dabei wird im Makro der Datei-Öffnen-Dialog angezeigt, um die Datei mit den Daten zu öffnen.
Den Namen der Zieltabelle muss du ggf. noch anpassen.
Gruss
Franz


Option Explicit
Sub Kopieren()
Dim wbAktiv As Workbook, wbDatei As Workbook, Datei
Dim wksZiel As Worksheet, wksDatei As Worksheet
Dim Wieder As Integer, I As Integer
Set wbAktiv = ActiveWorkbook
Set wksZiel = wbAktiv.Worksheets("Tabelle1")
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Set wbDatei = ActiveWorkbook
For I = 1 To 3
Set wksDatei = wbDatei.Worksheets(I)
With wksDatei
For Wieder = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Wieder, 1) = "DAT" Then _
.Range(.Cells(Wieder, 1), .Cells(Wieder, 20)).Copy _
wksZiel.Cells(wksZiel.Range("2000").End(xlUp).Offset(1, 0).Row, 1)
Next
End With
Next
wbDatei.Close
End Sub

Option Explicit Sub Kopieren() Dim Wieder As Long Dim wsQ As Worksheet, lngZ As Long With Sheets("Blatt1") lngZ = .Cells(Rows.Count, 1).End(xlUp).Row For Each wsQ In Workbooks("Leute.xls").Worksheets ' Quellmappe anpassen - muss offen sein For Wieder = 1 To 300 If wsQ.Cells(Wieder, 1) = "DAT" Then lngZ = lngZ + 1 Range(wsQ.Cells(Wieder, 1), wsQ.Cells(Wieder, 20)).Copy .Cells(lngZ, 1) End If Next Wieder Next wsQ End With End Sub

Option Explicit Sub Kopieren() Dim Wieder As Long Dim wsQ As Worksheet, lngZ As Long, strTxt as string With Sheets("Blatt1") strTxt = .Range("A5") ' evtl. anpassen lngZ = .Cells(Rows.Count, 1).End(xlUp).Row For Each wsQ In Workbooks("Quellmappe.xls").Worksheets ' Quellmappe anpassen - muss offen sein For Wieder = 1 To 300 If wsQ.Cells(Wieder, 1) = strTxt Then lngZ = lngZ + 1 Range(wsQ.Cells(Wieder, 1), wsQ.Cells(Wieder, 20)).Copy .Cells(lngZ, 1) End If Next Wieder Next wsQ End With End Sub

Sub Kopieren() Dim Wieder As Long Dim wsQ As Worksheet, lngZ As Long, strTxt As String strTxt = Sheets("ein anderes Blatt").Range("A5") ' anpassen With Sheets("Blatt1") lngZ = .Cells(Rows.Count, 1).End(xlUp).Row For Each wsQ In Workbooks("Quellmappe.xls").Worksheets ' Quellmappe anpassen - muss offen sein For Wieder = 1 To 300 If wsQ.Cells(Wieder, 1) = strTxt Then lngZ = lngZ + 1 Range(wsQ.Cells(Wieder, 1), wsQ.Cells(Wieder, 20)).Copy .Cells(lngZ, 1) End If Next Wieder Next wsQ End With End Sub

Beliebteste Forumthreads (12 Monate)

Kopieren von einer anderen Excel Datei

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren von einer anderen Excel Datei

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread