Zeitstempel im VBA ?

[ultrabest]

Hallo zusammen,

 In diesem Zeitstempel in der Formelösung :

[Excel] Zeitstempel / Datumsstempel per Formel

ausprobiert habe ich. Die Spalte D muss frei sein. In Spalte E setzt ich die Formel ein. Kapiert habe ich das nicht, aber es funktioniert.

Wie sieht eine VBA Lösung Zeitstempel  im Modul1 aus?

Viele Grüße 

ultrabest

[derHoepp]

Moin,

kannst du deine Frage etwas präzisieren? Was willst du erreichen?
Das aktuelle Datum und die Uhrzeit erhältst du mit der Now()-Funktion. In Zellen schreibst du, in dem du der .Value-Eigenschaft eines Range-Objektes etwas zuweist:

Code:

Range("A1").Value = "Hier ein Beispieltext"
Cells(2,1).Value = 20
Selection.Value = RueckgabeEinerFunktion()

Insgesamt ist das ein so grundlegendes Vorgehen, das wahrscheinlich in jedem VBA-Kurs innerhalb der ersten halben Stunde geklärt ist.

Viele Grüße
derHöpp

[UweD]

Hallo

so?

Code:

Sub Datei_kopieren()

    ' zwischen 2 offenen Arbeitsmappen
    
    Dim rng As Range, rng2 As Range
    
    'Range der Quelldatei definieren
    Set rng = Workbooks("TestB.xlsm").Worksheets(3).UsedRange 'Daten von Tabelle1 werden angesprochen
    'Daten ohne Header kopieren und einfügen
    'Daten von Tabelle1 werden kopiert nach Zieldatei Tabelle3!
   
    Set rng2 = ThisWorkbook.Worksheets(3).Range("A" & ThisWorkbook.Worksheets(3).Rows.Count).End(xlUp).Offset(1)
    Intersect(rng, rng.Offset(1)).Copy rng2
    rng2.Offset(0, 3).Resize(rng.Rows.Count - 1, 1) = Now
    
End Sub

LG UweD

[ultrabest]

Hallo zusammen. 

Sorry, dass ich mich jetzt melde. 

Genauer Ablauf :

Mit der Datei TestA kopiere ich die Daten von TestB.

1. Schritt Übertragung von Datei TestB nach Datei TestA >> Tabelle1 //  Funktioniert.

2.Schritt Übertragung von Datei TestB nach Datei TestA >> Tabelle 3 // Funktioniert.  

Mein Anliegen: 

Diesen Code habe ich gefunden und in Tabellenblatt 3 eingefügt, 

leider gibt er keinen Zeitstempel aus, wenn ich Daten aus Datei TestB  in Datei TestA // Tabelle 3 kopiere.  

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Or _
    Target.Count > 1 Then Exit Sub
   
Cells(Target.Row, "J") = Date

End Sub

Das Datum sollte man in Tabelle 3 / Zelle "J1" festlegen, bevor die Daten übertragen werden: (Noch nicht angelegt)

PS : Den Code von Uwe habe ich noch nicht ausprobiert.

Viele Grüße 
ultrabest

[derHoepp]

Moin,

Geh den Code gedanklich durch und Versuche dir jede Codezeile selbst zu erklären, dann kommst du schnell auf die Lösung.

Viele Grüße 
derHoepp

[ultrabest]

Hallo Uwe.

Der o.g. Code funktioniert nur wenn direkt in Zelle A2, A3 usw. etwas reingeschrieben wird, dann kommt der Zeitstempel.

Wenn man was einfügt, funktioniert nicht.  Da muss etwas im Code geändert werden, damit das "Einfügen" eine Aktion auslöst.

Mittlerweile habe ich habe ich einen neuen Code gefunden, der das genau macht.

Wenn in Zelle A2, A3 usw. etwas eingefügt wird, dann wird der Zeitstempel in Zelle J2, J3 usw. angezeigt.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Set Target = Intersect(Target, Range("A:A"))
  If Target Is Nothing Then Exit Sub
  Target.Offset(0, 9).Value = Date
End Sub

Viele Grüße
ultrabest

[ultrabest]

Guten Abend zusammen,

ich würde gerne eine Abfrage einbauen.

Datei "TestB.xlsm" soll geöffnet sein, bevor überhaupt kopiert wird.

Ist die Datei "TestB.xlsm" nicht geöffnet, soll die MsgBox "Daten kopieren nicht möglich" angezeigt werden.

Ich habe schon mehrere Versuche gemacht. Ich danke schon mal in Vorab. 

Gruß ultrabest

Code:

Sub Datei_kopieren()
   
    '-------------------------------------------------------
' Prüfen ob Quelldatei geöffnet ist, wenn nicht geöffnet dann
' MessageBox "Daten kopieren nicht möglich!"
   
   If Workbooks.Open("TestB.xlsm") = False Then
  
   MsgBox "Daten kopieren nicht möglich!", vbExclamation
  
  
End If
    '-------------------------------------------------------


' zwischen 2 offenen Arbeitsmappen kopieren

    Dim rng As Range

'Range der Quelldatei definieren
  Set rng = Workbooks("TestB.xlsm").Worksheets(3).UsedRange 'Daten von Tabelle1 werden angesprochen

'Daten ohne Header kopieren und einfügen
'Daten von Tabelle1 werden kopiert nach Zieldatei Tabelle3!
Intersect(rng, rng.Offset(1)).Copy _
ThisWorkbook.Worksheets(3).Range("A" & ThisWorkbook.Worksheets(3).Rows.Count).End(xlUp).Offset(1)

'Bereitgestellt von VBATrainer: www.vbatrainer.de


End Sub

[schauan]

Hallöchen,

1) Du kannst erst mal prüfen, ob die Datei schon offen ist - mittels der Workbooks-Auflistung
2) Wenn nicht, dann öffnest Du sie.
2a) Du kannst vorher prüfen, ob die Datei an der Stelle ist, wo Du sie öffnen willst.
3) Du kannst schauen, ob das Öffnen geklappt hat. Es könnte ja sein, dass die Datei war dort liegt, Du aber z.B. keine Rechte hast.

[ultrabest]

Hallo zusammen.

 
Jetzt habe ich hinbekommen. 


Gruß ultrabest

Code:

Option Explicit

Sub IstDateiGeoeffnet()
   
    Dim DateiName As String
   
    DateiName = "TestB.xlsm"  ' Passe den Namen entsprechend an

    On Error Resume Next
   
    If Workbooks(DateiName) Is Nothing Then
        MsgBox "Datei '" & DateiName & "' ist NICHT geöffnet.", vbExclamation
    Exit Sub
   
    End If
   
    On Error GoTo 0


    ' zwischen 2 offenen Arbeitsmappen kopieren

    Dim rng As Range

'Range der Quelldatei definieren
  Set rng = Workbooks("TestB.xlsm").Worksheets(3).UsedRange 'Daten von Tabelle1 werden angesprochen

'Daten ohne Header kopieren und einfügen
'Daten von Tabelle1 werden kopiert nach Zieldatei Tabelle3!
Intersect(rng, rng.Offset(1)).Copy _
ThisWorkbook.Worksheets(3).Range("A" & ThisWorkbook.Worksheets(3).Rows.Count).End(xlUp).Offset(1)

'Bereitgestellt von VBATrainer: www.vbatrainer.de


End Sub