Daten aus anderer Datei

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
ersetzte einfach den vorhandenen Sub "Daten_in_Blatt" durch diesen:

Option Explicit
Sub daten_in_Blatt()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lzeile As Long
Dim lzeile2 As Long
Dim rng As Range
Dim rng2 As Range
Dim wsAnzahl As Integer
Dim i, j
Dim x
Dim tabuTabellen '//Neu!
Dim y
Dim bool As Boolean
Dim count As Integer
'//Alte Daten entfernen
Call daten_loeschen
'//Anzahl der vorhandenen Sheets
wsAnzahl = ThisWorkbook.Sheets.count
i = 1: j = 0
x = Array(2, 5, 12)
tabuTabellen = Array("neueDatei", "Inhaltsverzeichnis", "Fragen", _
"Beispiel", "etc.") '//Neu!
Application.ScreenUpdating = False
Do
Set ws = ThisWorkbook.Sheets("neueDatei")
'//Neu!
bool = False
For y = 0 To UBound(tabuTabellen)
If ThisWorkbook.Sheets(i).Name = tabuTabellen(y) Then
count = count + 1
If count > 0 Then
bool = True
count = 0
End If
End If
Next y
If bool = True Then GoTo nextBlatt
Set ws2 = ThisWorkbook.Sheets(i)
'//Setzen des zu kopierenden Bereichs
'//anschließend Bereich kopieren
With ws2
lzeile2 = .Cells(.Rows.count, x(j)).End(xlUp).Row
Set rng2 = .Range(.Cells(10, x(j)), .Cells(lzeile2, x(j)))
lzeile2 = lzeile2 - 9
rng2.Copy
'//Setzten des Bereichs in dem anderer Bereich eingefügt wird
'//und einfügen der Daten in Bereich
With ws
lzeile = .Cells(.Rows.count, x(j)).End(xlUp).Row
Set rng = .Range(.Cells(lzeile + 1, x(j)), _
.Cells((lzeile + lzeile2), x(j)))
rng.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlPasteSpecialOperationNone
Application.CutCopyMode = False
.Range("A2").Select
End With
End With
nextBlatt:
i = i + 1
If i > (wsAnzahl) Then
j = j + 1
i = 1
End If
Loop Until j > 2
Application.ScreenUpdating = True
End Sub

Alles was ich hinzugefügt habe, habe ich mit dem Kommentar '//Neu "markiert"
Ist wirklich keine schöne Lösung aber sie funktioniert

Durch Range.Select gelangt man später lediglich zu eben dieser Zelle.
Das ist nur da damit man nach Abschluss des Makros nicht irgendwo in der Pampa landet.
Das kopieren der Werte findet hier statt:

            With ws2
lzeile2 = .Cells(.Rows.count, x(j)).End(xlUp).Row
Set rng2 = .Range(.Cells(10, x(j)), .Cells(lzeile2, x(j)))
lzeile2 = lzeile2 - 9
rng2.Copy

In der Beispiel Mappe die du mir gesendet hast, begannen die zu kopierenden Werte ab der Zeile 10!
Möchtest du also den zu kopierenden Bereich ändern musst du folgenden Wert, hier Fett markiert, abändern:

Set rng2 = .Range(.Cells(10, x(j)), .Cells(lzeile2, x(j)))

Um das Problem richtig nachvollziehen zu können wäre die aktuelle Datei von dir sehr
hilfreich.
Bitte denke aber daran, immer alle Sensiblen Daten zu entfernen bzw. zu ersetzten!

'//Setzten des Bereichs in dem anderer Bereich eingefügt wird '//und einfügen der Daten in Bereich With ws lzeile = .Cells(.Rows.count, x(j)).End(xlUp).Row Set rng = .Range(.Cells(lzeile + 1, x(j)), _ .Cells((lzeile + lzeile2), x(j))) rng.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlPasteSpecialOperationNone

'//Setzen des zu kopierenden Bereichs '//anschließend Bereich kopieren With ws2 lzeile2 = .Cells(.Rows.count, x(j)).End(xlUp).Row If lzeile2 = 9 Then lzeile2 = lzeile2 + 1 Set rng2 = .Range(.Cells(10, x(j)), .Cells(lzeile2, x(j))) If lzeile2

Beliebteste Forumthreads (12 Monate)

27
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus anderer Datei

27 Beiträge zum Forumthread Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

27
Beiträge zum Forumthread

Beiträge zu diesem Forumthread