Office: Range Array von einem Workbook in ein anderes kopieren

BerlinBlues · 27. April 2015

Hallo Experten!

Ich hoffe ihr könnt mir (wenig erfahren mit VBA) weiterhelfen.

Bitte beachten, ich arbeite mit einem Mac, also werden nicht alle Befehle unterstützt. Vor allem Workbook.Open

Ich möchte täglich Daten von einem Workbook in ein anderes Kopieren. Es gibt aber einen Bereich, in dem die Werte nicht statisch sind, das heißt, es kann sich um 3 Zeilen handeln, oder 10 oder 7, jeden Tag anders.

In der Quelldatei fängt dieser Bereich in Range("B10:H10") an. Die letzte Zeile fängt in Zelle B? mit "Gesamt:" an.

ich kann mit folgendem Code das auch schaffen:

Dim i As Integer
Dim x As Integer
Dim lieferant As String
Dim ScrRange As Range

Windows("Lieferungen.xls").Activate

i = 10
x = 0

Do Until lieferant = "Gesamt:"

Windows("Lieferungen.xls").Activate

lieferant = Cells(i, 2).Value
Set ScrRange = Range(Cells(i, 2), Cells(i, 7))

Windows("Reports.xlsm").Activate

ScrRange.Copy Destination:=Range(Cells(i + 13, 2), Cells(i + 13, 7))
i = i + 1
x = x + 1 '(Ich habe x, um die Gesamtzahl der Zeilen zu ermitteln.)

Loop

Wie gesagt, es funktioniert, ist aber sehr unschön, also wollte ich die Gelegenheit nutzen, endlich mal Arrays zu lernen um das Ganze hübscher zu gestalten. Aber seit nun mehr als fünf Stunden hilft mir Google nicht weiter.

Hier ist so meine Idee:

Dim i As Integer
Dim j As Integer
Dim x As Integer

Windows("Lieferungen.xls").Activate

i = 10
x = 0
j = 0

Do Until lieferant = "Gesamt:"
liefernat = Cells(i, 2).Value
i = i + 1
x = x + 1
Loop

(Jetzt weiß ich wie viele Zeilen ich kopieren muss)

Dim ArrRange() As Range

(Diese For... Next sollen die Variablen ArrRange(0), ArrRange(1), ArrRange(2) usw. mit Werte befüllen.
For j = 0 To x - 1
ArrRange(j) = Range(Cells(10 + j, 2), Cells(10 + j, 7))
Next j

Windows("Reports.xlsm").Activate

(Diese nächste Schleife soll die Variablen ArrRange(0), ArrRange(1), ArrRange(2) usw. in einen Range kopieren.)

For j = 0 To x - 1
ArrRange(j).Copy Destination:=Range(Cells(j + 24, 2), Cells(j + 24, 7))
Next j

Ich bekomme aber eine Vielzahl von Fehlermeldungen, z.B. Konstate benötigt, außerhalb des definierten Bereichs, usw.

Ich hoffe einer von euch hat eine simple und für mich verständliche Lösung.

Vielen Dank!!!

:)

Mc Santa · 29. April 2015

Hallo,

ich habe mal ein paar Zeilen geschrieben, wie ich es vermutlich lösen würde und alles ausführlich kommentiert.
Bitte gehe den Code durch und versuche alles zu verstehen. Frage mich gerne auch bei Kleinigkeiten, ich denke dadurch kannst du viel lernen *Smilie
Code:

Sub mcsanta()

'Lege Quelle und Ziel in Variablen fest!
'Springe NICHT mit Activate und Select durch Tabellen und Dateien
Dim Quelle As Worksheet: Set Quelle = Workbooks("Lieferungen").Worksheets("Tabelle1")
Dim Ziel As Worksheet: Set Ziel = ThisWorkbook.Worksheets("Tabelle1")

'Optional aber sehr hilfreich und übersichtlich
'Benenne Konstanten, wenn sich bestimmte Dinge innerhalb deines Programs nicht ändern
'Statt 10 schreibst du nun immer die Konstante und weißt auch später was gemeint ist
Const ersteZeileQuelle As Long = 10
Const ersteZeileZiel As Long = 24

Dim i As Long
Dim lastrow As Long
Dim meinArray

'Finde das "Ende" in deiner Tabelle (hier die Zelle mit "Gesamt:"
With Quelle
'lese Spalte 2 in einen Array ein, aber nur im benutzten Bereich deines Blattes
meinArray = Intersect(.Columns(2), .UsedRange)

'Durchlaufe diesen Array von unten nach oben (ist schneller ;) )
For i = UBound(meinArray) To LBound(meinArray) Step -1

'Falls das Ende gefunden wird: speichere die letzte Zeile und beende die Schleife
If meinArray(i, 1) = "Gesamt:" Then lastrow = i: Exit For
Next i
End With

'Kopiere den Bereich
'Dazu wird die erste Zelle der Quelle gewählt und auf den gesamten Bereich vergößert:
'nach unten um folgende Anzahl: lastrow - ersteZeileQuelle + 1
'nach rechts um folgende Anzahl: 6
'
'Im Ziel musst du nur die erste Zelle angeben, Excel erweitert den Bereich automatisch
Quelle.Cells(ersteZeileQuelle, 2).Resize(lastrow - ersteZeileQuelle + 1, 6).Copy _
Destination:=Ziel.Cells(ersteZeileZiel, 2)
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hatte keine Dateien zum testen, daher bitte einen kurzen Hinweis, falls es Fehler gibt *wink.gif*

VG
Santa

BerlinBlues · 29. April 2015

Vielen lieben Dank!

Ich werde das morgen gleich testen, dann gebe ich Dir einen Feedback.

BerlinBlues · 30. April 2015

WOW - magisch. Es hat perfekt funktioniert. Ich musste lediglich .xls hinter dem Workbooknamen setzen, by SetQuelle....

Eine Frage habe ich: wenn ich Bezug auf Workbook("Book1").Worksheet("Sheet1") nehmen will, aber das Workbook nur dieses eine Sheet hat, muss ich das Sheet explizit erwähnen?

Ich danke dir vielmals.

BerlinBlues · 30. April 2015

Hallo noch mal,

im selben Bericht, den ich erstelle, habe ich eben erfahren, dass ein Bereich, den ich kopieren soll, auch "dynamisch" ist. Ich dachte mit dem Teil bin ich fertig, weil alles immer gleich bleibt. Pch gehabt.

Diese Zeile mit den Arrays würde perfekt passen, ich habe es schon getestet, aber in der Quelldatei ist jede zweite Zeile leer gelassen worden, und genauso wird es übertragen.

Wäre es einfach das so zu ergänzen, dass jede leere Zeile ignoriert wird und die Werte dann ohne leere Zeilen übertragen werden?

Mc Santa · 30. April 2015

Hallo,

Das Blatt musst du immer angeben, auch wenn es nur ein einziges gibt.

Für die Frage mit den leeren Zellen kann ich mir eine Antwort vorstellen, aber am besten lädst du mir dafür mal eine Beispiel-Datei hoch. Quelle und Ziel können einfach zwei Blätter in dieser Datei sein.

Viele Grüße
Santa

BerlinBlues · 4. Mai 2015

ich habe eine Datei angehängt. Ich hoffe,es hat geklappt. Unter Tab Fremdfirma habe ich die Angaben so formatiert, wie ich sie täglich bekomme, also Spalte und Zeile stimmen. Ich habe auch die Zeilen ausgeblendet, wie Sie im Original auch sind.

Unter Mein_Unternehmen habe ich gezeigt, wohin die Daten kopiert werden sollen. Bitte beachten, dass die Namen und Anzahl der Ware immer unterschiedlich sind, deshalb der Bedarf nach Arrays.

Vielen Dank noch mal für deine Hilfe!

xlph · 4. Mai 2015

Hallo,

das geht auch ohne Arrays...

Code:

Sub xlph()

Dim rngF_Gesamt As Range

Dim wksBlatt_Q As Worksheet ' Quelle
Dim wksBlatt_Z As Worksheet ' Ziel

Set wksBlatt_Q = ThisWorkbook.Worksheets("Fremdfirma") ' ggf. Anpassen
Set wksBlatt_Z = ThisWorkbook.Worksheets("Mein_Unternehmen") ' ggf. anpassen

Application.ScreenUpdating = False

' Ziel-Bereich säubern
With wksBlatt_Z
.Range(.Range("B2"), .Range("B2").End(xlDown)).Resize(, 2).Clear
End With

With wksBlatt_Q

' Nach 'Gesamt:' in QuellBereich suchen
Set rngF_Gesamt = .Range("B11:B" & .Rows.Count).Find("Gesamt:", , xlValues, xlWhole)

If Not rngF_Gesamt Is Nothing Then

' Werte sichtbarer Zellen nach Ziel kopieren
.Range("B10:C" & rngF_Gesamt.Row).SpecialCells(xlCellTypeVisible).Copy
Tabelle1.Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False

' Ziel-Bereich mit Rahmen versehen (Unter-/Oberstrich)
wksBlatt_Z.Range("B2").Resize(, 2).Borders(xlEdgeBottom).Weight = xlMedium
wksBlatt_Z.Range("B2").End(xlDown).Resize(, 2).Borders(xlEdgeTop).Weight = xlMedium

Else
' Meldung falls kein 'Gesamt:' gefunden
MsgBox "Kein 'Gesamt:' in [" & .Name & "]!"
End If

End With

Set rngF_Gesamt = Nothing
Set wksBlatt_Q = Nothing
Set wksBlatt_Z = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

BerlinBlues · 4. Mai 2015

Ich bekomme in der Zeile
Code:

Tabelle1.Range("B2").PasteSpecial xlPasteValues
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bei Tabelle1 die Fehlermeldung "Variable nicht definiert". Ich habe es mit vielen definierten Variablen ersetzt, aber dann kam immer "außerhalb des gültigen Bereichs". Was muss genau dort stehen?

EDIT: Ich habe die richtige Variable gefunden, jetzt kommt keine Fehlermeldung mehr, aber in der Zieldatei ist immer noch jede zweite eine leere Zeile. Vielleicht sind die Zeilen nicht ausgeblendet, sonder nur minimiert bzw. Zeilenhöhe = 0??

EDIT 2: Ja, sie sind auf 0 Höhe.... sorry

Mc Santa · 4. Mai 2015

Hallo,

statt Tabelle1 sollte dort eigentlich wksBlatt_Z stehen.

VG
Santa

BerlinBlues · 4. Mai 2015

Wäre es einfach den Code so zu ändern, dass nicht ausgeblendeten Zeilen nicht berücksichtigt werden, sonder die leeren?

Mc Santa · 12. Januar 2021

von BerlinBlues

Wäre es einfach den Code so zu ändern, dass nicht ausgeblendeten Zeilen nicht berücksichtigt werden, sonder die leeren?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja das geht,

ersetze folgende Codezeile:
Code:

.Range("B10:C" & rngF_Gesamt.Row).SpecialCells(xlCellTypeVisible).Copy
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

durch diese:
Code:

.Range("B10:C" & rngF_Gesamt.Row).SpecialCells(xlCellTypeConstants, 23).Copy
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Funktioniert das in deiner Datei?

VG
Santa

BerlinBlues · 5. Mai 2015

Nein, an der Stelle kommt jetzt Laufzeitfehler 1004 : Bei einer Markierung von nicht angrenzenden Zeilen ist die Ausführung dieses Befehls nicht möglich.

Mc Santa · 5. Mai 2015

Hm, dann sieht deine echte Datei anders aus, als dei Beispieldatei, da habe ich den Code erfolgreich getestet.

Da vielleicht beim Einfügen etwas schief gegangen ist, hier der Code von xlph mit meinen Anpassungen:
Code:

Sub xlph()
Dim rngF_Gesamt As Range
Dim wksBlatt_Q As Worksheet ' Quelle
Dim wksBlatt_Z As Worksheet ' Ziel
Set wksBlatt_Q = ThisWorkbook.Worksheets("Fremdfirma") ' ggf. Anpassen
Set wksBlatt_Z = ThisWorkbook.Worksheets("Mein_Unternehmen") ' ggf. anpassen
Application.ScreenUpdating = False

With wksBlatt_Z
' Ziel-Bereich säubern
.Range(.Range("B2"), .Range("B2").End(xlDown)).Resize(, 2).Clear
End With

' Nach 'Gesamt:' in QuellBereich suchen
Set rngF_Gesamt = wksBlatt_Q.Range("B11:B" & wksBlatt_Q.Rows.Count).Find( _
"Gesamt:", , xlValues, xlWhole)
If Not rngF_Gesamt Is Nothing Then
' Werte sichtbarer Zellen nach Ziel kopieren
.Range("B10:C" & rngF_Gesamt.Row).SpecialCells(xlCellTypeConstants, 23).Copy
wksBlatt_Z.Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
' Ziel-Bereich mit Rahmen versehen (Unter-/Oberstrich)
wksBlatt_Z.Range("B2").Resize(, 2).Borders(xlEdgeBottom).Weight = xlMedium
wksBlatt_Z.Range("B2").End(xlDown).Resize(, 2).Borders(xlEdgeTop).Weight = xlMedium
Else
' Meldung falls kein 'Gesamt:' gefunden
MsgBox "Kein 'Gesamt:' in [" & wksBlatt_Q.Name & "]!"
End If
Set rngF_Gesamt = Nothing
Set wksBlatt_Q = Nothing
Set wksBlatt_Z = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Falls das in deiner Datei nicht klappt, müsstest du eine neue Beispieldatei hochladen, in der man den Fehler nachstellen kann.

VG
Santa

BerlinBlues · 5. Mai 2015

Es klappt nicht, in der gleichen Zeile kommt die Fehlermeldung "Nicht zulässiger oder nicht gekennzeichneter Verweis."

Also kopierte ich die Dateien und wollte diese hochladen. Beim Öffnen kommt jedoch sofort eine Fehlermeldung bei Code:

Sub Workbook_Open()

Hauptmenü.Show

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hauptmenü ist mein Userform. Warum das in der kopierte Datie nicht funktioniert, weiß ich nicht.

Ich bin verzweifelt, zumal das Projekt bereits drei Tage überfällig ist. Ich werde mich mit einer unschönen Lösung zufrieden geben müssen. Ich danke euch vielmals für eure Mühe.

Office: Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren

Range Array von einem Workbook in ein anderes kopieren - Similar Threads - Range Array Workbook

Rangfolge stimmt nicht, doppelte Zeilen

Range der Abfrage erhöhen

Excel Range als Bild in Word einfügen

Variant Array in Range

Array mit Range aus InputBox befüllen geht nicht

VBA Funktion Range in Array umwandeln

Mehrdimensionales Array mit Range-Funktion füllen