Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1532to1536
1532to1536
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren von Daten von Wb1 nach Wb2

Forumthread: Kopieren von Daten von Wb1 nach Wb2

Kopieren von Daten von Wb1 nach Wb2
16.01.2017 12:50:28
Daten
Hallo
das Problem ist nicht das schöde Kopieren, sondern folgender Sachverhalt:
Erstmal das Setting
1. Die beiden Dateien sind bereits geöffnet.
2. In WB1 ist auf Blatt 1 ein Pull-Down Menü mit den Monaten. Der Anwender soll einen Monat auswählen.
3. WB2 hat 12 Blätter nach Monaten benannt
Dann zu VBA:
1. Es soll zu WB2 gesprungen werden. Und zwar genau zu dem Blatt, das dem Monat entspricht, welcher in WB1 ausgewählt wurde. Es soll die Range D6:AH6 kopiert werden.
2. Es soll zurück zu WB1 gesprungen werden, zu Blatt 3. Ab E5 soll die Auwahl eingefügt werden aber transponiert!
3. Dann soll wieder zurück auf WB2 gesprungen werden, aber mit der Range D7:AH7 zum kopieren.
4. Zurück zu WB1, diesmal zu Blatt 4, dann wieder transponieren. usw.
5. Dies soll insgesamt 15 mal Durchlaufen.
Und was ich gar nicht hinkriege:
Der Startpunkt der Selection zum Einfügen ist E5 wie oben beschrieben. Dies gilt aber nur für den Januar.
Wird Februar ausgwählt ist der Startpunkt E46, bei März E87 usw, also immer 41 Zeilen dazu.
Es wäre eine Riesenhilfe!
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispieldatein?
16.01.2017 14:44:17
Michael
Hi,
das läßt sich alles machen, aber die halbe Stunde zum Nachbasteln vorhandener Dateien mag ich nicht investieren, zumal die Aufgabenstellung zu viele Fragen offenläßt.
Am besten steckst Du beide in eine ZIP-Datei, dann bleiben die Dateinamen unverändert.
Schöne Grüße,
Michael
Anzeige
MA-Daten schaufeln: bitte testen
17.01.2017 13:55:05
Michael
Hi Georg,
ich verwende zum Zippen übrigens gerne 7zip: http://www.7-zip.de/
Anbei beide Dateien mit "in sich unveränderten Namen": https://www.herber.de/bbs/user/110644.zip
Es fällt auf, daß Du "inkonsistente" Namen verwendest: in der 110625 steht in Daten & Abr. MA1, MA2, ebenso die Blattnamen. In 110626 steht je ein Leerzeichen zwischen MA und der Nr. - so geht's nicht.
Ich habe in Letzterer bei ein paar Daten das Leerzeichen zum Testen entfernt. Man könnte dort eine weitere Spalte mit abgekürzten Namen einfügen und diese als Blattnamen verwenden - das erfordert nur ein paar wenige Änderungen im Makro, die Du evtl. selbst hinbekommst.
Im Moment sieht es so aus: 
Option Explicit
Sub kopieren()
Dim z&, s&, abZ&     ' & = as long; m:Monat,z:Zeile,s:Spalte,abZ:ab Zeile
Dim mNr&             ' Nr. des Monats
Dim a, aT            ' ohne = as Variant; als Array; aT: transp. Daten
Dim eNr&             ' zwischengespeicherte err.number
Dim d2$, m$          ' $ = as string; d2: 2. Datei(Name), m: Monat
Dim t0 As Single     ' mal sehen, wie lange es dauert
t0 = Timer
d2 = "110626.xlsx"   ' hier entsprechend anpassen
' Du kannst den Namen hier "fest verdrahten" oder Du steckst ihn beim
' Öffnen der Datei (das Makro hast Du ja offensichtlich bereits) in eine
' bestimmte Zeile in "Abr" und liest ihn von dort ein, z.B. d2 = Range("R9")
' Angabe ohne Pfad genügt i.d.R.
' Array für transp. Ausgabe dimensionieren
ReDim aT(1 To 31, 1 To 1)
Range("r18:s100").ClearContents ' Ausgabebereich leeren
' Daten für Import aus Blatt "Abr" übernehmen
m = Range("s14").Value
If Trim(m) = "" Then MsgBox "kein Monat: Abbruch": Exit Sub
abZ = Range("s16").Value: mNr = Range("r16").Value
Windows(d2).Activate ' hier evtl. auch Fehlerbehandlung
On Error Resume Next
a = Sheets(m).Range("B6:AG25") ' immer 31 Tage - könnte man aber "flexibilisieren"
eNr = Err.Number        ' FehlerNr. zwischenspeichern
On Error GoTo 0
ThisWorkbook.Activate ' ist immer die Datei, die das Makro enthält
If eNr  0 Then MsgBox "Fehler: " & Err.Number & " Abbruch.": Exit Sub
For z = 1 To UBound(a)
If Trim(a(z, 1)) = "" Then
Exit For
Else
For s = 1 To 31: aT(s, 1) = a(z, s + 1): Next
'         Stop
On Error Resume Next
Sheets(a(z, 1)).Range("E" & abZ).Resize(31) = aT
eNr = Err.Number
On Error GoTo 0
If eNr = 0 Then a(z, 2) = "ok" Else a(z, 2) = "n.v."
End If
Next
Range("r18").Resize(z - 1, 2) = a
MsgBox "fertig in " & Round((Timer - t0) * 1000, 3) & " ms."
End Sub

Geht mit den paar Testdaten ratz-fatz.
Schöne Grüße,
Michael
Anzeige
AW: MA-Daten schaufeln: bitte testen
17.01.2017 14:20:38
Georg
HALLO Michael,
genial, ich hätte es so definitiv nicht hingekriegt, da fehlen mir notwendige Detailkenntnisse.
Ich habs an den Dateien des ZIP Archiv probiert, geht, jetzt werde ich das mal auf die "echten" Dateien übertragen und anpassen.
VIELEN DANK!!!!!!!!!!!!!! Beste Grüße georg
Anzeige
freut mich, gern geschehen,
17.01.2017 16:21:28
Michael
Georg,
ich wünsche viel Erfolg beim Anpassen!
Happy Exceling,
Michael

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige