Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen in andere Datei kopieren VBA

Zellen in andere Datei kopieren VBA
16.01.2017 11:42:05
Tobias
Hallo zusammen,
ich möchte mithilfe eines Makros die Zellinhalte diverser Tabellenblätter kopieren und in eine andere Datei schreiben. Die Zellen auf den Blättern im Bereich(A1:Z100) enthalten alle Formeln, die ich nicht mitkopieren möchte, sondern nur den Inhalt. (Das klappt auch schon ganz gut). Nun möchte ich aber dass die Zellen die "" sind (meine Formeln geben entweder einen Text oder "") nicht mitkopiert werden, sondern wirklich nur die Zellen die einen Text oder eine Zahl oder eine Kombination aus Text und Zahl sind.
ich dachte daran vll die Zellen vorher zu markieren mit .specialCell aber irgendwie kriege ich es nicht hin.
danke im Vorraus und hier mal mein bisheriger Code

Sub Schaltfläche1_Klicken()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim QWB As Workbook, ZWB As Workbook
Dim QWS1 As Worksheet, ZWS1 As Worksheet
Dim QWS2 As Worksheet, ZWS2 As Worksheet
Dim QWS3 As Worksheet, ZWS3 As Worksheet
Dim QWS4 As Worksheet, ZWS4 As Worksheet
Dim QWS5 As Worksheet, ZWS5 As Worksheet
Dim QWS6 As Worksheet, ZWS6 As Worksheet
Dim QWS7 As Worksheet, ZWS7 As Worksheet
Dim QWS8 As Worksheet, ZWS8 As Worksheet
Dim QWS9 As Worksheet, ZWS9 As Worksheet
Dim QWS10 As Worksheet, ZWS10 As Worksheet
Dim QWS11 As Worksheet, ZWS11 As Worksheet
Dim QWS12 As Worksheet, ZWS12 As Worksheet
Dim QWS13 As Worksheet, ZWS13 As Worksheet
Dim QWS14 As Worksheet, ZWS14 As Worksheet
Dim QWS15 As Worksheet, ZWS15 As Worksheet
Dim QWS16 As Worksheet, ZWS16 As Worksheet
Dim QWS17 As Worksheet, ZWS17 As Worksheet
Dim ZWS18 As Worksheet
On Error Resume Next
Set QWB = Workbooks("Makro_Zum_Übertragen.xlsm")
If QWB Is Nothing Then
Set QWB = Workbooks.Open("Pfad...")
End If
Set ZWB = Workbooks("andere_Datei.xlsx")
If ZWB Is Nothing Then
Set ZWB = Workbooks.Open("Pfad...")
End If
On Error GoTo 0
Set QWS1 = QWB.Worksheets("Q1")   ' Quelle
Set ZWS1 = ZWB.Worksheets("Z1")    ' Ziel
Set QWS2 = QWB.Worksheets("Q2")    'Quelle
Set ZWS2 = ZWB.Worksheets("Z2")    'Ziel
Set QWS3 = QWB.Worksheets("Q3")   ' Quelle
Set ZWS3 = ZWB.Worksheets("Z3")    ' Ziel
Set ZWS4 = ZWB.Worksheets("Z4")    ' Ziel
Set QWS4 = QWB.Worksheets("Q4")   ' Quelle
Set QWS5 = QWB.Worksheets("Q5")   ' Quelle
Set ZWS5 = ZWB.Worksheets("Z5")    ' Ziel
Set ZWS6 = ZWB.Worksheets("Z6")    ' Ziel
Set QWS6 = QWB.Worksheets("Q6")   ' Quelle
Set QWS7 = QWB.Worksheets("Q7")   ' Quelle
Set ZWS7 = ZWB.Worksheets("Z7")    ' Ziel
Set ZWS8 = ZWB.Worksheets("Z8")    ' Ziel
Set QWS8 = QWB.Worksheets("Q8")   ' Quelle
Set QWS9 = QWB.Worksheets("Q9")   ' Quelle
Set ZWS9 = ZWB.Worksheets("Z9")    ' Ziel
Set ZWS10 = ZWB.Worksheets("Z10")    ' Ziel
Set QWS10 = QWB.Worksheets("Q10")   ' Quelle
Set QWS11 = QWB.Worksheets("Q11")   ' Quelle
Set ZWS11 = ZWB.Worksheets("Z11")    ' Ziel
Set ZWS12 = ZWB.Worksheets("Z12")    ' Ziel
Set QWS12 = QWB.Worksheets("Q12")   ' Quelle
Set ZWS13 = ZWB.Worksheets("Z13")    ' Ziel
Set QWS13 = QWB.Worksheets("Q13")   ' Quelle
Set ZWS14 = ZWB.Worksheets("Z14")    ' Ziel
Set QWS14 = QWB.Worksheets("Q14")   ' Quelle
Set ZWS15 = ZWB.Worksheets("Z15")    ' Ziel
Set QWS15 = QWB.Worksheets("Q15")   ' Quelle
Set ZWS16 = ZWB.Worksheets("Z16")    ' Ziel
Set QWS16 = QWB.Worksheets("Q16")   ' Quelle
Set ZWS17 = ZWB.Worksheets("Z17")    ' Ziel
Set QWS17 = QWB.Worksheets("Q17")   ' Quelle
Set ZWS18 = ZWB.Worksheets("Z18")    ' Ziel
QWS1.Range("A1:Z201").Copy
ZWS1.Range("A1").PasteSpecial xlPasteValues
QWS2.Range("A1:Z201").Copy
ZWS2.Range("A1").PasteSpecial xlPasteValues
QWS3.Range("A1:Z201").Copy
ZWS3.Range("A1").PasteSpecial xlPasteValues
QWS3.Range("A1:Z201").Copy
ZWS4.Range("A1").PasteSpecial xlPasteValues
QWS4.Range("A1:Z201").Copy
ZWS5.Range("A1").PasteSpecial xlPasteValues
QWS5.Range("A1:Z201").Copy
ZWS6.Range("A1").PasteSpecial xlPasteValues
QWS6.Range("A1:Z201").Copy
ZWS7.Range("A1").PasteSpecial xlPasteValues
QWS7.Range("A1:Z201").Copy
ZWS8.Range("A1").PasteSpecial xlPasteValues
QWS8.Range("A1:Z201").Copy
ZWS9.Range("A1").PasteSpecial xlPasteValues
QWS9.Range("A1:Z201").Copy
ZWS10.Range("A1").PasteSpecial xlPasteValues
QWS10.Range("A1:Z201").Copy
ZWS11.Range("A1").PasteSpecial xlPasteValues
QWS11.Range("A1:Z201").Copy
ZWS12.Range("A1").PasteSpecial xlPasteValues
QWS12.Range("A1:Z201").Copy
ZWS13.Range("A1").PasteSpecial xlPasteValues
QWS13.Range("A1:Z201").Copy
ZWS14.Range("A1").PasteSpecial xlPasteValues
QWS14.Range("A1:Z201").Copy
ZWS15.Range("A1").PasteSpecial xlPasteValues
QWS15.Range("A1:Z201").Copy
ZWS16.Range("A1").PasteSpecial xlPasteValues
QWS16.Range("A1:Z201").Copy
ZWS17.Range("A1").PasteSpecial xlPasteValues
QWS17.Range("A1:Z201").Copy
ZWS18.Range("A1").PasteSpecial xlPasteValues
QWB.Close
ZWB.Save
ZWB.Close
Application.EnableEvents = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
ungetestet
16.01.2017 17:49:46
Michael
Hi Tobias,
zunächst läßt sich das Makro deutlich kürzer schreiben; das ist "kein Wert an sich", hat aber gewisse Vorteile...
Sub Schaltfläche1_Klicken()
Dim QWB As Workbook, ZWB As Workbook
Dim qWS As Worksheet, zWS As Worksheet
Dim i As Long, vN As Variant, vNt As Variant
' mit so einer Konstante läßt sich das alles übersichtlicher
' erfassen bzw. ändern...
Const vonNach = "1,1;2,2;3,3;3,4;4,5;5,6;6,7;7,8;8,9;" _
& "9,10;10,11;11,12;12,13;13,14;14,15;15,16;16,17;17,18"
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Set QWB = Workbooks("Makro_Zum_Übertragen.xlsm")
If QWB Is Nothing Then
Set QWB = Workbooks.Open("Pfad...")
End If
Set ZWB = Workbooks("andere_Datei.xlsx")
If ZWB Is Nothing Then
Set ZWB = Workbooks.Open("Pfad...")
End If
On Error GoTo 0
vN = Split(vonNach, ";")
' vN ist dann ein "Array" mit *allen* Wertepaaren 1,1 und 2,2 usw.
For i = 0 To UBound(vN)
vNt = Split(vN(i), ",")
' vNt = "Array" mit *einem* Wertepaaren (0) ist die erste,
' (1) die zweite Ziffer
' bei 1,1 wird dann aus "Q" & vNt(0) "Q1" bzw. aus
' "Z" & vNt(1) "Z1"
QWB.Worksheets("Q" & vNt(0)).Range("A1:Z201").Copy
ZWB.Worksheets("Z" & vNt(1)).Range("A1").PasteSpecial xlPasteValues
Next
QWB.Close
ZWB.Save
ZWB.Close
Application.EnableEvents = True
End Sub

...nämlich das Erfassen der Blätter an EINER Stelle (in der Const), was dazu führt, daß innerhalb der Schleife immer das Gleiche passiert, nur mit anderen Werten - das ist weniger anfällig für Tippfehler.
In diesem Fall wird es auch weniger Speicher verbraten.
Jedenfalls fällt auf, daß bis 3 immer n:n kopiert wird, dann aber 3 erneut auf 4 und dann immer n:n+1; ist das beabsichtigt?
Der eigentliche Punkt ist damit aber noch nicht gelöst: Excel kann nicht mehrere Bereiche (oder Bereiche mit "Löchern") kopieren.
Stellst Du Dir das so vor, daß in der Zieltabelle evtl. vorhandene Werte stehenbleiben (bzw. nicht überschrieben werden), wenn in der Quelltabelle "leere" Zellen sind?
Dann müßte man noch intensiveren Gebrauch von "Arrays" machen.
Ändere ich gerne auf Zuruf, aber teste mal bitte zunächst den Code, ob er zufriedenstellend läuft. Ich konnte es ja nicht mangels Dateien.
Schöne Grüße,
Michael
Anzeige
AW: ungetestet
17.01.2017 08:09:10
Tobias
hallo Michael,
erstmal danke für deine Antwort. Das Chaos ist perfekt denn ich habe einen Doppelpost verursacht und somit deine Antwort in diesem Beitrag erst jetzt gelesen. Der "Fehler" mit Q3 ist beabsichtigt.
Zum Hintergrund. Meine Tabellenblätter werden von zeit zu zeit ergänzt mit neuen Werten. (Es werden immer mehr jedoch niemals weniger Werte). Diese Tabellenblätter möchte ich in eine andere Datei schreiben. Die Zellen aus den Quelltabellenblätter enthalten aufgrund von Formeln sehr oft einen Wert von "". Optisch sind die Zellen zwar leer aber der Wert von "" wird momentan mitkopiert und das ist für meine weitere Bearbeitung ein Problem. (Dynamische Bereichsmarkierung für Dropdownfelder).
Die Werte der Zieldateitabellenblätter können und sollen bei jedem ausführen plump überschrieben werden.
mit ner Schleife wollte ich das kopieren nicht machen da meine konkreten Tabellenblattnamen anders sind (ich habe Sie abgeändert für den Beitrag im Forum). Natürlich kann man den Code am Ende noch hübsch machen aber erstmal suche ich eine Lösung dafür auf einem gewissen Tabellenblatt alle Werte zu markieren und zu kopieren die nicht den Wert "" haben. Diesen Vorgang würde ich dann für die restlichen 17 Tabellenblätter genauso nochmal schreiben =) Sollte das dann funktionieren mach ich mir Gedanken wie man den Code verbessern könnte in Bezug auf Länge und Performance.
nochmals vielen Dank für die Antwort, ich hoffe ich konnte meine Problematik verständlich machen
Anzeige
wenig Änderungen
17.01.2017 14:07:44
Michael
Hi Tobias,
tut mir leid, ich schreibe keinen Code, der nicht meiner Auffassung vom "Stand der Technik" entspricht.
Du kannst den vorhandenen Code dennoch verwenden, indem Du einfach in die Konstante die effektiven Blattnamen reinschreibst, also statt "1,1;2,2;usw" dann eben so:
Sub Schaltfläche1_Klicken()
Dim QWB As Workbook, ZWB As Workbook
Dim qWS As Worksheet, zWS As Worksheet
Dim i As Long, vN As Variant, vNt As Variant
' mit so einer Konstante läßt sich das alles übersichtlicher
' erfassen bzw. ändern...
Const vonNach = "Hinzvon,Hinznach;Kunzvon,Kunznach;uswvon,uswnach" ' ***
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Set QWB = Workbooks("Makro_Zum_Übertragen.xlsm")
If QWB Is Nothing Then
Set QWB = Workbooks.Open("Pfad...")
End If
Set ZWB = Workbooks("andere_Datei.xlsx")
If ZWB Is Nothing Then
Set ZWB = Workbooks.Open("Pfad...")
End If
On Error GoTo 0
vN = Split(vonNach, ";")
' vN ist dann ein "Array" mit *allen* Wertepaaren 1,1 und 2,2 usw.
For i = 0 To UBound(vN)
vNt = Split(vN(i), ",")
' vNt = "Array" mit *einem* Wertepaaren (0) ist der erste,
' (1) der zweite Eintrag; bei "Kunzvon,Kunznach" wird dann
' aus vNt(0) "Kunzvon" bzw. aus
' aus vNt(1) "Kunznach"
QWB.Worksheets(vNt(0)).Range("A1:Z201").Copy ' ***
ZWB.Worksheets(vNt(1)).Range("A1").PasteSpecial xlPasteValues ' ***
Next
QWB.Close
ZWB.Save
ZWB.Close
Application.EnableEvents = True
End Sub

Das eigentliche Problem ist insofern aber nicht nachvollziehbar: mit pastespecial werden "leere" Zellen auch leer kopiert: geht es um "" oder um " " (mit einem Leerzeichen)?
Schöne Grüße,
Michael
Anzeige
AW: wenig Änderungen
18.01.2017 08:32:34
Tobias
Hallo Michael,
zunächst danke für deine Bemühungen.
dein Code ist sehr schön, mein Problem ist leider nach wie vor da. (Ich bin mir sicher, dass es an meiner mangelnden Erklärung liegt). Gibt es prinzipiell eine Möglichkeit die For Schleife so zu erweitern dass nicht nur der Bereich A1:Z201 mit allen Zellen kopiert wird, sondern dass vorher nur diejenigen Zellen markiert werden zum kopieren, die kein "" enthalten (ohne Leerzeichen).
Wenn ich alle Zellen auf bisherigem Weg kopiere kann ich meinen Tabellen im Anschluss nicht mehr einen dynamischen Bereichsbezug geben. (=BEREICH.VERSCHIEBEN(Konfigurator!$BP$16;0;0;ANZAHL2(Konfigurator!$BP$16:$BP$216);1) Diese Option brauch ich um später ein Dropdownfeld einzubauen, welches mir dann per Mausklick zB 80 unterschiedliche Parameter in der erscheinenden Liste zur Auswahl gibt.
Sind die restlichen Zellen aber mit einem "" beschrieben funktioniert das ganze nicht mehr und ich erhalte in meiner Dropdownliste 120 weiße Felder, die ebenfalls zur Auswahl stehen und das möchte ich vermeiden.
Die kopierten Zellen sehen zwar leer aus, aber die namensorientierte Bereichsmarkierung funktioniert dann nicht mehr.
Ich habe in dem genannten Beispiel bereits getestet ob die Bereichsmarkierung wieder funktioniert wenn ich die 120 "leeren" Zellen lösche und das funktioniert auch.
Selbst wenn wir keine Lösung für mein Problem finden so habe ich über deinen Code bereits viel neues gelernt und bin dafür sehr dankbar
Eine Sache hab ich bei der Schleife noch nicht verstanden: wieso erhält mein QWB(vNt) den Startindex 0 und mein ZWB(vNt) den Startindex 1, ich dachte die Schleife muss für beide den selben Index haben. (Wertepaarung 0:0;1:1;...)
Anzeige
AW: wenig Änderungen
19.01.2017 06:48:31
Michael
Hi,
probiere mal die Änderungen:
https://www.herber.de/bbs/user/110692.xlsm
vN(i) ist ein *Paar* mit zwei Blattnamen, die wiederum in vNt gesplittet werden: vNt(0) ist der linke (vor dem Komma), vNt(1) der rechte.
Schöne Grüße,
Michael
AW: wenig Änderungen
19.01.2017 07:05:49
Tobias
Vielen Dank Michael, ich werde versuchen das heute umzusetzen

346 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige