Office: Einzelne Zellen auslesen/exportieren per VBA

Hi an alle,

ich habe in Excel 07 ein Formular, das jeden Tag von neuem ausgefüllt wird. Nach dem Ausfüllen möchte ich, dass sich das Formluar schließt, die auszufüllenden Felder zurückgesetzt werden (auf "0") und die eben gemachten Angabe in einer neuen Arbeitsmappe gespeichert werden, allerdings jeweils unter Berücksichtigung des Datums. Das mit dem Speichern und dem Zurücksetzten habe ich hinbekommen, mit dem Auslesen bin ich allerdings überfordert.
Ich habe in der neuen Arbeitsmappe einen "Kalender" in Form einer Tabelle angelegt. Nun möchte ich ja, dass jeden Tag bei Speichern des Formulars die Werte in die Zelle des jeweiligen Tages (z.B. am 1.August in die Zelle unter 01.08.08, am 2. August in die Zelle unter 02.08.08 etc.) übertragen werden, sodass ich quasi eine Sammeltabelle mit den Werten aller Tage bekomme und diese dann anschließend am besten auch gleich noch gespeichert und geschlossen wird.
In der Mappe mit dem Formular befindet sich eine Zelle mit dem aktuelle Datum (=HEUTE()).

In der Hoffnung, mein Problem anschaulich dargestellt zu haben... :-?

Gruß
Babsi

 

Ganz grober Ablauf wäre also, ob nach Button-Druck oder beim "Schließen"-Ereignis der aktuellen Mappe:

• 1) Öffnen der Kalender-Mappe, Aktivieren des passenden Blatts.
  2) aktuelles Datum aus der Formular-Mappe nehmen und passendes Datum in den Zeilen der Kalender-Mappe suchen.
  3) Aktualisieren der Werte in der Kalender-Mappe mit den Werten aus der Formular-Mappe
  4) Schließen der Kalender-Mappe mit Speichern der Änderungen

1) kann mit Stichworten wie "workbooks.open" und "workbooks(w2).worksheets(s2).activate" erledigt werden.
3) ist relativ simples "thisworkbook.worksheets(s1).cells(y1,x1).copy destination:=worksbooks(w2).worksheets(s2).cells(y2,x2)".
4) würde sich mit "workbooks(w2).close savechanges:=true" erledigen lassen.

Etwas aufwendiger ist eigentlich nur das Suchen des passenden Datums. Dort wäre ggf. auch noch eine Sicherheitsabfrage angebracht, wenn bereits Werte vorhanden sind, ob diese überschrieben werden sollen.

Wenn ich mal davon ausgehen darf, daß Du in Spalte 1 der Kalender-Mappe ab Zeile 2 (in der 1. Zeile die Überschriften) abwärts das komplette Jahr mit Datums-Werten gefüllt hast, dann würde sowas in der Art gehen:

Code:

set sht2=workbooks(w2).worksheets(s2)
'Anfang der Liste mit den Datumswerten
y2=2:x2=1
dtm2=trim$(sht2.cells(y2,x2).value)
'Liste bis zum Ende (leere Zelle) abarbeiten
while (dtm2<>"")
    if (dtm2=dtm1) then
        'kopieren der werte
        '[...]
        y2=65535
    endif
    y2=y2+1:x2=1
    dtm2=trim$(sht2.cells(y2,x2).value)
wend
'Ende Liste, aber nicht Ende Blatt --> Wert nicht gefunden
if (y2<65536) then
    msgbox 'Datum nicht gefunden"
  else
    msgbox "Werte aktualisiert"
endif

dtm1 müßte bereits mit dem aktuellen Datum (dim dtm1 as date) belegt sein. y1 und x1 (dim y1 as long, dim x1 as long) sollten Zeile und Spalte der Werte beinhalten, die in das Kalender-Blatt kopiert werden sollen.

Ach ja, die passenden DIMs zu Obigem:

Code:

dim sht2 as worksheet
dim y2 as long
dim x2 as long
dim dtm2 as date

(ungetestet, Tippfehler vorbehalten, aber der Ablauf sollte klar werden.)

Gruß, Michael

 

falls du nur in der ersten Spalte was reinschreiben willst dann würd ich im
[für andere Projektmappe weß ich nicht aber mit dem untereinander schreiben =)
Code bsp:

Code:

Dim Zeile1 As Integer
Zeile1 = 1
Cells(Zeile1, 1) = PROJEKTMAPPE.ARBEITSBLATT.Cells(1,1) 'Zelle wo Datum drinsteht dann reinschreiben'
Zeile1 = Zeile1 + 1

So addiert er immer die Zeile + 1 wenn er diesen Vorgang macht schreibt automatisch dann in die Zelle rein =)
und man musst nicht mehrüberprüfen usw.

Hoffe das ist was du meinst =)

 

Hallo ihr beiden,

zunächst danke für die Antworten, Michael hat das Problem eigentlich ziemlich genau auf den Kopf getroffen :-) Mit deinen Schritten 1) und 4) hatte ich keinerlei Probleme, allerdings bin ich bei 3) hängengeblieben. Ich hatte dies nicht richtig beschrieben.

Es wird zwar mit deinem Code korrekt die Zelle kopiert, allerdings möchte ich NUR den Wert kopiert haben, nicht aber das Format und die Formel, da Excel sonst logischerweise einen falschen Bezug hat.

Außerdem gab es bei 2.) wie erwartet größere Schwierigkeiten und ich war mit meinem kleinen VBA-Latinum schnell am Ende :-)

Ich habe deinen Code wie folgt abgeändert:

Code:

Private Sub CommandButton4_Click()

Dim sht2 As Worksheet
Dim y2 As Long
Dim x2 As Long
Dim dtm2 As Date

Set sht2 = Workbooks([b]"Zieldatei.xlsx"[/b]).Worksheet([b]"2008"[/b])

y2 = [b]10[/b]: x2 = [b]4[/b]
dtm2 = Trim$(sht2.Cells(y2, x2).Value)

While (dtm2 <> "")
    If (dtm2 = dtm1) Then
      
      
        y2 = 65535
    End If
    y2 = y2 + 1: x2 = 1
    dtm2 = Trim$(sht2.Cells(y2, x2).Value)
Wend

If (y2 < 65536) Then
    MsgBox "Datum nicht gefunden"
  Else
    MsgBox "Werte aktualisiert"

End If
End Sub

Da ich mich mit den von dir benutzten Codes nicht wirklich auskenne, habe ich einfach mal nach bestem Wissen und vor allem Gewissen meine Variablen eingesetzt (fett gedruckt)...leider bekomme ich dann einen Laufzeitfehler 9 ausgespuckt. (gelb markiert wird die Zeile: Set sht2 = Workbooks("Zieldatei.xlsx").Worksheet("2008") Vielleicht kannst du mir ja sagen, an welchen Stellen genau ich dein Skript abändern muss, dass es funktioniert?! Das wäre super.

Gruß
Babsi

 

Wenn diese Zeile einen Fehler verursacht, wäre mein erster Verdacht, daß die Datei in dem Moment nicht geöffnet ist. Du erstellst mit dem SET eine Referenz auf die Arbeitsmappe, und das geht nur, wenn sie in dem Moment auch geöffnet ist. Dafür mußt Du ggf. vorher mit einem ".open" sorgen.

Oh, und ich sehe gerade... Da fehlt ein "s"... Es sollte "worksheets" heißen, also Mehrzahl. Das wäre auch ein Grund für eine Fehlermeldung.

Code:

y2 = 10: x2 = 4

Ok, damit sagst Du dem Programm, daß es in Zeile 10 und Spalte 4 (also "D10") anfangen soll. Aber, weiter unten:

Code:

y2 = y2 + 1: x2 = 1

Den haste übersehen. ;-) Hier muß also auch wieder "x2 = 4" gesetzt werden.

Genau genommen kann man das auch ganz weglassen (also nur das "x2=...", das "y2=..." muß unbedingt bleiben!), aber ich benutz es gerne, um innerhalb der WHILE-WEND-Geschichte x auch mal temporär mit anderen Werten belegen zu können, ohne daß es dadurch zu Probleme kommt. Noch "stilvoller" wäre am Anfang, direkt hinter dem "private sub..." ein

Code:

const startzeile = 10
const startspalte = 4

und dann am Anfang ein

Code:

y2 = startzeile: x2 = startspalte

sowie vor dem WEND dann

Code:

y2 = y2 + 1: x2 = startspalte

Dann braucht man nur noch die CONST-Anweisungen anzupassen, wenn sich der Tabellenaufbau ändert.

Gruß, Michael

PS: Das "fett" klappt nicht innerhalb von "code", weil innerhalb "code" keinerlei Formatierungen möglich sind.

 

Dann ändert sich das copy leicht, muß dann in 2 Schritten gemacht werden:

Code:

workbooks(b1).worksheets(s1).cells(y1,x1).copy
workbooks(b2).worksheets(s2).cells(y2,x2).pastespecial paste:=xlpastevalues

Durch das "paste:=..." sagt man, was genau eigentlich nur kopiert (eingefügt) werden soll, in diesem Fall "nur Werte", womit die Formatierungen erhalten bleiben, Formel-Ergebnisse aber gleichzeitig als Konstanten eingefügt werden.

btw: ich benutz hier immer "cells(y,x)" als "range", aber es gibt da durchaus auch andere Möglichkeiten:

Code:

s1.range("a10:d11")

würde 2x4 Zellen umfassen, die in einem Rutsch kopiert werden könnten. Ist aber nur sinnvoll, wenn man mindestens die Spalten konstant weiß. Da kann man auch was zusammenbasteln:

Code:

s1.range("a" & x1 & ":d" & x2)

Das hätte die gleiche Wirkung, wenn x1 mit 10 und x2 mit 11 belegt sind.

Sonst geht auch:

Code:

s1.range(s1.cells(y1,x1),s1.cells(y2,x2))

Und wenn man eine ganze Zeile kopieren möchte, ist

Code:

s1.rows(y1)

eine schön kurze Alternative.

Gruß, Michael

 

Hi Michael,

das mit dem .pasteValue hat wunderbar geklappt.

Allerdings meckert Excel weiterhin bei der Suche nach dem Datum :). Ich habe vorher ein ".open" eingebaut, was auch funktioniert, also bei Ablauf des Makros wird die Zieldatei richtig geöffnet, allerdings kommt dann ein Laufzeitfehler '13', "Typen unverträglich." Gelb markiert ist hierbei die erste folgende Zeile des Codes (while...):

While (dtm2 <> "")
'muss ich hier zwischen den "" etwas einfügen?
If (dtm2 = dtm1) Then


y2 = 65535
End If
y2 = y2 + 1
dtm2 = Trim$(sht2.Cells(y2, x2).Value)

y2 = y2 + 1: x2 = startspalte
Wend

If (y2 < 65536) Then
MsgBox "Datum nicht gefunden"
Else
MsgBox "Werte aktualisiert"

End If

End Sub

An welcher Stelle dieses Codes fragt Excel eigentlich das akutelle Datum ab (steht dtm1 für das aktuelle?) , bzw sucht in dem Kalender nach dem aktuellen? Die eingangs angegebenen Werte für const startzeile = 10
const startspalte = 3 steht doch für die Startzelle des Kalenders oder?

Gruß
Babsi

 

Hi Michael,

das mit dem .pasteValue hat wunderbar geklappt.

Allerdings meckert Excel weiterhin bei der Suche nach dem Datum :). Ich habe vorher ein ".open" eingebaut, was auch funktioniert, also bei Ablauf des Makros wird die Zieldatei richtig geöffnet, allerdings kommt dann ein Laufzeitfehler '13', "Typen unverträglich." Gelb markiert ist hierbei die erste folgende Zeile des Codes (while...):

While (dtm2 <> "")
'muss ich hier zwischen den "" etwas einfügen?
If (dtm2 = dtm1) Then


y2 = 65535
End If
y2 = y2 + 1
dtm2 = Trim$(sht2.Cells(y2, x2).Value)

y2 = y2 + 1: x2 = startspalte
Wend

If (y2 < 65536) Then
MsgBox "Datum nicht gefunden"
Else
MsgBox "Werte aktualisiert"

End If

End Sub

An welcher Stelle dieses Codes fragt Excel eigentlich das akutelle Datum ab (steht dtm1 für das aktuelle?) , bzw sucht in dem Kalender nach dem aktuellen? Die eingangs angegebenen Werte für const startzeile = 10
const startspalte = 3 steht doch für die Startzelle des Kalenders oder?

Gruß
Babsi

 

Das passiert, wenn z.B. ein String-Wert auf eine Zahl-Variable oder sonst irgendein unpassendes Format auf eine Variable zugewiesen wird.

Ähm, ja... Die Kombination

Code:

Dim dtm2 As Date
[...]
dtm2 = Trim$(sht2.Cells(y2, x2).Value)
[...]
While (dtm2 <> "")

ist dafür verantwortlich. dtm2 wird als Datums- (und damit Zahl-) Variable deklariert, aber dann mit trim$ ein String zugewiesen. Da war der "Pseudocode" etwas zu kurz gefasst. Für die while-Schleife braucht man streng genommen eine eigene Variable:

Code:

dim tst2 as string
[...]
tst2 = Trim$(sht2.Cells(y2, x2).Value)
While (tst2 <> "")
    dtm2 = sht2.Cells(y2, x2).Value
[...]
    tst2 = Trim$(sht2.Cells(y2, x2).Value)
wend

Die "dim"-Zeile und die erste "dtm2=..."-Zeile müssen zusätzlich in den Code, die anderen Zeilen sind nur so geändert, daß statt dtm2 jetzt tst2 benutzt wird.

Danach wird also tst2 als String-Variable für den Test benutzt, ob eine Zelle leer ist oder nicht. Und wenn sie nicht leer ist, dann wird der eigentlich zu verarbeitende Wert in die Variable dtm2 gesetzt.

Dann kann die Schleife eigentlich nur noch an die Wand fahren, wenn in der Liste (Kalenderblatt) zwar Werte stehen, die aber kein Datum sind.

Nein, das gehört so. Hier fragt das Programm ab, ob die Variable einen leeren String enthält. Damit wird das Ende der Liste (die erste leere Zelle unterhalb der Liste) erkannt. Die Schleife wird so lange durchlaufen, wie es ungleich "" (leer) ist.

dtm1 ist das Datum aus der 1. Tabelle, der "aktuelle" Datensatz. dtm2 ist das Datum, daß gerade in der durchsuchten Zeile der 2. Tabelle, dem Kalender, steht. Wenn im Kalender ein kpl. Jahr aufgelistet ist, erhält dtm2 der Reihe nach alle Werte vom 1. Januar bis zum 31. Dezember, es sei denn...

Mit der Zeile "if dtm2=dtm1" wird überprüft, ob das Datum, daß gerade in der Liste steht (dtm2), mit dem Datum übereinstimmt, was gesucht wird (dtm1). Und bei einer Übereinstimmung ("Datum gefunden") wird das gemacht, was zwischen dem IF und dem ENDIF steht.

Dort wird dann u.a. auch der Zeilen-Pointer y2 auf 65535 gsetzt. Zusammen mit dem y2=y2+1 am Ende der while-Schleife erreicht sie damit 65536 und somit das Ende der Excel-Tabelle. Diese Tabelle sollte dann wirklich leer sein und die Schleife wird daraufhin verlassen.

Daraus resultierend auch das IF-Konstrukt mit den msgbox am Ende: Wird das Datum gefunden, wird y2 auf 65536 stehen. Wird es nicht gefunden, zeigt y2 auf die Zeile mit der ersten leeren Zelle nach der Liste, also z.B. 234.

Yep, genau. Das sollte die Sache eigentlich nur etwas übersichtlicher (und leichter veränderbar) machen.

Gruß, Michael

 

Hi Michael,

cool, soweit funktioniert es jetzt schonmal :-D Nun zum ursprünglichen Problem: Wie bekomme ich die Zellen aus der Quelldatei in die jeweils zudem Datum passende Zelle kopiert?! Bzw. wie integriere ich den Code zum kopieren der Zelle aus der Quelldatie:

Code:

Private Sub CommandButton2_Click()
Workbooks("Quelldatei.xlsm").Worksheets("s1").Cells(y1, x1).Copy
Workbooks("Zieldatei.xlsx").Worksheets("2008").Cells(10, 4).PasteSpecial Paste:=xlPasteValues
End Sub

Meines Erachtens muss der Code doch in die Else Bedingung am Ende des "Datum suchen"-Codes oder nicht? Allerdings hat der obenstehende Code ja feste Zellen, wo er den Wert einfügt (hier 10,4), aber er soll den Wert ja da einfügen, wo das entsprechende Datum davorsteht...hmmm :?:

Desweiteren ist mir noch nicht ganz klar, wie Excel das aktuelle Datum mit dtm1 verknüpft, schließlich hab ich ihm ja bis jetzt an keiner Stelle des Codes gesagt, mit welcher "Zelle" er dtm1 definieren soll?! (Meiner Laienansicht nach müsste ich doch dem dtm1 diejenige Zelle zuweisen, die das aktuelle Datum (generiert über =HEUTE()) enthält oder nicht?!)

Ist mir echt schon unangenehm, jedes Detail nachfragen zu müssen, aber ich denke, wir (bzw. du :-) ) sind jetzt schon so weit mit der Problemlösung, dass es schade wäre, das ganze sein zu lassen...

Gruß
Babsi

 

Ach watt, dat passt schon... ;-)

Ok, gehen wir mal ein paar Postings zurück:

Die 1) hast Du ja schon eingebaut, wie Du geschrieben hattest. Das war die Geschichte mit dem ".open".

Die 2) haben wir im Prinzip fertig, zumindest den 2. Teil, das Suchen. Das ursprüngliche Datum festzulegen, sollte ziemlich trivial sein. Aber da kannst nur du sagen, woher es genommen werden soll. Du schriebst:

Aber: Welches Datum? Wird das von Hand eingegeben oder soll das aktuelle Datum genommen werden? Je nachdem:

a) manuelle Eingabe, das Datum steht in Zelle C5:

Code:

dtm1 = sht1.cells(5,3).value

(eine passende "Set sht1 = ..." Zeile ist da Voraussetzung. Mit sht2 kennst Du das ja schon.)

b) aktuelles Datum:

Code:

dtm1 = now()

Und eine dieser beiden Zellen müßte dann vor die while-Schleife.

Die 3) wird dann innerhalb der while-Schleife zwischen if und endif erledigt:

Code:

y1 = quellzeile : x1 = quellspalte : s1.cells(y1,x1).copy
x2 = zielspalte : s2.cells(y2,x2).pastespecial paste:=xlpastevalues

Diese 2 Zeilen tauchen direkt nach dem if ggf. mehrfach auf. Entscheidend ist dabei die Zuweisung auf y1, x1, und x2. Nehmen wir mal an, Du möchtest die Werte aus C5, E2 und G3 in das Kalenderblatt in die Spalten 2, 3 und 4 zum passenden Datum kopieren:

Code:

'C5 nach ~2
y1 = 5 : x1 = 3 : s1.cells(y1,x1).copy
x2 = 2 : s2.cells(y2,x2).pastespecial paste:=xlpastevalues
'E2 nach ~3
y1 = 2 : x1 = 5 : s1.cells(y1,x1).copy
x2 = 3 : s2.cells(y2,x2).pastespecial paste:=xlpastevalues
'G3 nach ~4
y1 = 3 : x1 = 7 : s1.cells(y1,x1).copy
x2 = 4 : s2.cells(y2,x2).pastespecial paste:=xlpastevalues

Naja, und dann bleibt nur noch das Schließen der Kalendermappe mit

Code:

wkb2.close savechanges:=true

übrig und das sollte es gewesen sein. Ach so, ja... Dafür brauchst Du dann noch

Code:

dim wkb2 as workbook
set wkb2 = workbooks(zieldatei)

am Anfang, sozusagen passend zu den "set sht...". Ach, und bei der Gelegenheit kannst Du die sogar noch etwas vereinfachen:
aus

Code:

set sht1 = workbooks("book1").worksheets("sheet1")

wird dann

Code:

set wkb1 = workbooks("book1")
set sht1 = wkb1.worksheets("sheet1")

Viel Erfolg... ;-) Und wenn's noch Probleme gibt, wäre jetzt wahrscheinlich der Zeitpunkt erreicht, wo Du die komplette Routine posten müßtest, da ja doch schon einiges an Änderungen und Erweiterungen drinsteckt.

Gruß, Michael

 

Hi Michael,

heute nachmittag war ich kurz davor, Freudensprünge zu machen, da plötzlich alles genauso funktioniert hat, wie ich es wollte. Die richtigen Werte wurden von der Quelldatei in die Zieldatei in die passende Zelle neben den "05.08.08" kopiert. Allerdings währte meine Freude nur kurz, ich hab gleich mal in Windows das Datum verstellt. Leider hat es dann nicht mehr funktioniert. Sowohl für den 04.08.08 als auch für den 06.08.08 wurde die msgBox "Datum nicht gefunden" ausgegeben. Ich hab dann extra nochmal bis jetzt gewartet (nach 00:00 :-D ), aber es funktioniert wirklich nur für den 05.08.08. Ich kann es mir nicht erklären, auch nachdem ich jetzt mehrmals die Routine durchgesucht habe...(zumindest soweit ich sie verstehe ;-)) Vielleicht kannst du mir den Fehler nennen...:

Code:

Private Sub CommandButton4_Click()


Const startzeile = 10
Const startspalte = 3

Dim sht2 As Worksheet
Dim y2 As Long
Dim x2 As Long
Dim dtm2 As Date
Dim tst2 As String
Dim wkb2 As Workbook


If CLng(ThisWorkbook.Worksheets("s1").Cells(1, 1).Value) < 1 Then

ThisWorkbook.Worksheets("s1").Cells(1, 1).Value = 1

End If
 'diese If-Bedingung habe ich zusätzlich eingebaut, hat keinen Einfluss auf das Problem

y2 = startzeile: x2 = startspalte

Workbooks.Open Filename:=ActiveWorkbook.Path & ("\Zieldatei.xlsx")
Set sht2 = Workbooks("Zieldatei.xlsx").Worksheets("gesamt")
Set wkb2 = Workbooks("Zieldatei.xlsx")
Set wkb1 = Workbooks("Quelldatei.xlsm")
Set sht1 = wkb1.Worksheets("s1")

tst2 = Trim$(sht2.Cells(y2, x2).Value)

dtm1 = sht1.Cells(2, 10).Value

While (tst2 <> "")
    dtm2 = sht2.Cells(y2, x2).Value
    If (dtm2 = dtm1) Then
      
y1 = 29: x1 = 10: Workbooks("Quelldatei.xlsm").Worksheets("s1").Cells(y1, x1).Copy
x2 = 4: sht2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues

y1 = 29: x1 = 10: Workbooks("Quelldatei.xlsm").Worksheets("s2").Cells(y1, x1).Copy
x2 = 5: sht2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues

y1 = 29: x1 = 10: Workbooks("Quelldatei.xlsm").Worksheets("s3").Cells(y1, x1).Copy
x2 = 6: sht2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues

y1 = 29: x1 = 10: Workbooks("Quelldatei.xlsm").Worksheets("s4").Cells(y1, x1).Copy
x2 = 7: sht2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues

      
        y2 = 65535
    End If
    y2 = y2 + 1
    tst2 = Trim$(sht2.Cells(y2, x2).Value)
    
    y2 = y2 + 1: x2 = startspalte
Wend

If (y2 < 65536) Then
    
    MsgBox "Datum nicht gefunden"
  

End If

wkb2.Close savechanges:=True

End Sub

Gruß
Babsi

 

Dafür sehe ich auch keinen Grund, hmmm... Es sei denn...

Ich bin bislang davon ausgegangen, daß Dein Kalenderblatt bereits mit allen Datums-Werten (wie war nochmal die Mehrzahl von Datum? ;-) ) lückenlos und sortiert untereinander vom 1. Januar bis zum 31. Dezember gefüllt ist. Das ist doch korrekt, oder?

Wenn das nicht der Fall ist, dann müßte das Kalenderblatt dynamisch erweitert werden, wenn das geforderte Datum noch nicht in der Liste ist. Dafür läßt sich das IF-Konstrukt nach der WHILE-Schleife benutzen.

Dort müßte dann nur das neu einzutragende Datum ans Ende der Liste gesetzt werden (y2 zeigt auf die erste leere Zeile nach der Liste), das Kopieren gemacht werden wie bei "gefunden" und dann sinnvollerweise die Liste nach Datum sortiert werden.

Aber wenn bereits alle Datums-Werte in der Liste sind, dann... hmmm... versteh ich jetzt auch nicht, wieso es bei einem Datum geht und bei einem anderen nicht.

Jetzt so würde ich nur etwas "Kosmetik" am Source machen:

Code:

Set sht2 = Workbooks("Zieldatei.xlsx").Worksheets("gesamt")
Set wkb2 = Workbooks("Zieldatei.xlsx")

Das läßt sich, analog zu wkb1 und sht1, auch kürzer schreiben:

Code:

Set wkb2 = Workbooks("Zieldatei.xlsx")
Set sht2 = wkb2.Worksheets("gesamt")

Außerdem vermisse ich die DIM-Anweisungen für wkb1 und sht1, genauso wie die für y1 und x1 und auch dtm1. Hast Du etwa kein "option explicit" als allerallererste Zeile in Deinem Source? ;-)

Nach erfolgtem SET läßt sich auch Dein IF-Konstrukt vereinfachen:

Code:

If CLng(ThisWorkbook.Worksheets("s1").Cells(1, 1).Value) < 1 Then
    ThisWorkbook.Worksheets("s1").Cells(1, 1).Value = 1
End If

wird dann zu

Code:

If CLng(sht1.Cells(1, 1).Value) < 1 Then
    sht1.Cells(1, 1).Value = 1
End If

Nur rein für die Übersichtlichkeit, für den Ablauf der Anweisungen, würde ich die Reihenfolge einiger Zeilen ändern, um besser erkennen zu können, wo was passiert. Aus dem Block

Code:

y2 = startzeile: x2 = startspalte

Workbooks.Open Filename:=ActiveWorkbook.Path & ("\Zieldatei.xlsx")
Set sht2 = Workbooks("Zieldatei.xlsx").Worksheets("gesamt")
Set wkb2 = Workbooks("Zieldatei.xlsx")
Set wkb1 = Workbooks("Quelldatei.xlsm")
Set sht1 = wkb1.Worksheets("s1")

tst2 = Trim$(sht2.Cells(y2, x2).Value)

dtm1 = sht1.Cells(2, 10).Value

While (tst2 <> "")

Würde ich

Code:

Workbooks.Open Filename:=ActiveWorkbook.Path & ("\Zieldatei.xlsx")
Set wkb1 = Workbooks("Quelldatei.xlsm")
Set sht1 = wkb1.Worksheets("s1")
Set wkb2 = Workbooks("Zieldatei.xlsx")
Set sht2 = wkb2.Worksheets("gesamt")

dtm1 = sht1.Cells(2, 10).Value

y2 = startzeile: x2 = startspalte
tst2 = Trim$(sht2.Cells(y2, x2).Value)
While (tst2 <> "")

machen. Erst die Dateien bereitstellen, dann grundsätzliche Parameter festlegen und dann den eigentlichen Ablauf starten.

Die Kopier-Geschichte ist einfacher zu schreiben, gerade weil ja die SET-Geschichten am Anfang sitzen. So wird z.B. aus

Code:

y1 = 29: x1 = 10: Workbooks("Quelldatei.xlsm").Worksheets("s1").Cells(y1, x1).Copy

ganz einfach ein

Code:

y1 = 29: x1 = 10: sht1.Cells(y1, x1).Copy

Du siehst: Durch das Verwenden der mit SET gesetzten Variablen spart man sich einen Haufen Tipparbeit und vermeidet dadurch auch ganz leicht Tippfehler. Außerdem ist die Pflege viel einfacher, wenn sich Datei- oder Blatt-Namen später mal ändern sollten. Dann muß man nämlich nur an einer einzigen Stelle die Namen anpassen.

Aber wie gesagt, das ist alles irgendwie nur Kosmetik. An der eigentlichen Funktionalität ändert sich da nichts.

Autsch... Da fällt mir was ein... dtm1 und 2 sind ja "komplette" Datumswerte, also neben dem Tag ist dort in dem Nachkommateil auch eine Uhrzeit enthalten! Hmpf, daran hab ich ja jetzt fast nicht mehr gedacht...

Ändere mal

Code:

dtm1 = sht1.Cells(2, 10).Value

in

Code:

dtm1 = int(sht1.Cells(2, 10).Value)

Das schneidet die Uhrzeit ab bzw. setzt sie auf 0 Uhr. Ich gehe mal davon aus, daß in Deinem Kalenderblatt auch nur reine Datums-Werte mit "0-Uhr-Wert" stehen. Wenn sht1.Cells(2, 10) seinen Wert aber durch "now()" erhält, wird es beim späteren Vergleich in der While-Schleife nicht zum Treffer kommen. Der 1. Januar 2008 00:00:00 Uhr ist eben was anderes als der 1. Januar 2008 11:27:35 Uhr...

Gruß, Michael

 

Hi Michael,

mit der Übersichtlichkeit hast du natürlich Recht, ich hab deine Änderungsvorschläge auch gerne übernommen :-)

Mittlerweile hatte ich herausgefunden, dass das mit dem Datum nicht nur für den 05.08.08 sondern für alle ungeraden Datums (Mehrzahl kenn ich auch nicht, nach den Latein-Reglen müsste es glaube ich Data heißen --> o-Deklination auf "-um" :?: :mrgreen: ). Die geraden Daten findet er nicht. Daraufhin hab ich folgenden Teil der Source (nach der zweiten If-Bed.) abgeändert (nach Bauchgefühl ):

Code:

y2 = y2 + 1
    tst2 = Trim$(sht2.Cells(y2, x2).Value)
    
    y2 = y2 + 1: x2 = startspalte

in

Code:

   tst2 = Trim$(sht2.Cells(y2, x2).Value)
    
    y2 = y2 + 1: x2 = startspalte

woraufhin er jetzt jedes Datum findet. Wirklich erklären kann ich es mir nicht, aber das erledigst sicher du für mich :roll:
Ich hoffe ich habe durch das Löschen von "y2 = y2 +1" nichts falsch gemacht, bzw. das Skript so beschnitten, dass es an einer anderen Stelle nicht mehr stimmt...

Ich habe dann noch ein letztes Problemchen...im Formular hab ich CommandButtons, die gewisse Werte generieren (die dann später in die andere Arbeitsmappe übernommen werden) Nun habe ich das Formularblatt schützen wollen, um es vor ungewollter Verunglimpfung zu bewahren. Dann kommt allerdings bei Auslösen der hinterlegten Routine eine Fehlermeldung mit einem roten Kreuz und dahinter steht "400". klicke ich auf ok, wird trotzdem alles ordnungsgemäß ausgeführt...entferne ich den Blattschutz, klappt alles wie vorher. Gibt es dafür eine Erklärung?

Gruß
Babsi