Zeiten addieren - komprimieren-----

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sepp,
wieder mal einen (Fehler ??) in den Griff bekommen.
Ich brauche nun nocheinmal deine Hilfe.
Beim Übertragen werden Leere Zellen mit 0 übertragen.
In der Zieltabelle wird die Zelle auf LEER geprüft - bei Null kommt der Hinweis #WERT.
Kann man für leere Zellen -Blank- übertragen?
In deinem Ersatz für den Codebereich:
With objShVA
.Unprotect Password:=""
.Range("E9:I15") = objShDaten.Range("K8:O14").Value
.Range("E16:I18") = objShDaten.Range("K16:O18").Value
.Protect Password:="", UserInterfaceOnly:=True
End With
(Ich habe die Zellbezüge angepasst.)
Die Zellen in der Zieltabelle die keine 0 enthalten dürfen sind I9:I18.
In der Zieltabelle kann ich diese Prüfung leider nicht umstellen - Dann bekomme ich dort Fehlermeldungen)-.
Wie gelingt es mir anstelle 0 - BLANK bei diesen Zellen zu übertragen?
Es geht auch, dass ich alle zu übertragene Zellen die 0 als Inhalt haben mit BLANK übertrage.
-------------------------
Dann ist noch ein Fehler aufgetreten.
Wenn die Zielmappe geschlossen ist, dann werden die Daten übertragen. Falls diese aber offen ist kommt ein Fehler.
Am besten wäre es, dass das Makro sowohl bei geschlossener als auch bei geöffneter Datei überträgt. Wenn dies nicht möglich ist, geht auch der Hinweis -Bitte (Zielmappe) schließen. Bei geöffneter Datei kann keine Übertragung erfolgen. (Abbruch)-
----------------------------
Hallo Sepp - Hans und....
wie Sepp es schon richtig sagte - geht es mir darum VBA kennzulernen. Dies geht am allerbesten mit praktischen Projekten. Diese habe ich hier. Es macht Spass Ideen zu realisieren. Un dich finde es absolut super, dass es dieses Forum gibt.
Lerarnig by doing ist meine Devise. Und hier kann ich mit sehr proffesioneller Hilfe dies tun.
Auf keinen Fall sollte sich jemand betroffen fühlen, falls auch ein anderer zusätzliche Hilfen gibt. Kritik an Codes werde und -kann ich auch garnicht, da wie jeder weis, ich gar keine Beurteilung von gut schlecht oder sonst was machen kann- üben. Es zeigt mir nur die Vielfalt und gibt mir die Sichtweise anderer sich zum Ergebnis hinzuarbeiten.
Nur als Bemerkung.
------------------------
Gruß
Joachim

Hallo Joachim!
So sollte es laufen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Makro überträgt die Daten aus "K8:N14,K16:N18" in die Mappe VERARBEITUNG "E9:H15,E16:H18"
' alles soll sich im aktiven Verzeichnis abspielen - Keine Pfadfestlegung - Beide Mappen müssen sich im selben
' Verzeichnis befinden - Name der Mappe DATEN kann frei gewählt werden.
' Läuft noch nicht !!!!!!!!!!!!!!

Sub Daten_übertragen()
Dim objWbVA As Workbook
Dim objShDaten As Worksheet, objShVA As Worksheet
Dim strFile As String
Dim lngCalculation As Long
Dim rng As Range
Dim blnWasOpen As Boolean

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  lngCalculation = .Calculation
  .Calculation = xlCalculationManual
  .Cursor = xlWait
End With

strFile = ThisWorkbook.Path & "\VERARBEITUNG.xls"

On Error Resume Next
blnWasOpen = True
Set objWbVA = Workbooks("VERARBEITUNG.xls")
If Err.Number > 0 Then
  Err.Clear
  On Error GoTo ErrExit
  Set objWbVA = Workbooks.Open(strFile)
  blnWasOpen = False
End If

Set objShVA = objWbVA.Sheets("Tabelle1")
Set objShDaten = ThisWorkbook.Sheets("Tabelle1")

With objShVA
  .Unprotect Password:=""
  For Each rng In objShDaten.Range("K8:O14")
    If rng <> "" And rng <> 0 Then
      .Cells(rng.Row + 1, rng.Column - 6) = rng.Value
    End If
  Next
  For Each rng In objShDaten.Range("K16:O18")
    If rng <> "" And rng <> 0 Then
      .Cells(rng.Row, rng.Column - 6) = rng.Value
    End If
  Next
  ' .Range("E9:I15") = objShDaten.Range("K8:O14").Value
  ' .Range("E16:I18") = objShDaten.Range("K16:O18").Value
  .Protect Password:="", UserInterfaceOnly:=True
End With

ErrExit:

If Not objWbVA Is Nothing And Not blnWasOpen Then objWbVA.Close True

If Err.Number > 0 Then
  If Err.Number = 1004 Then
    MsgBox "Die Zielmappe ist nicht vorhanden - Abbruch", 48, "Abbruch!"
  Else
    MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  End If
  Err.Clear
Else
  MsgBox "Die Daten wurden erfolgreich übertragen!", 64, "Hinweis"
End If

Set objWbVA = Nothing
Set objShVA = Nothing
Set objShDaten = Nothing

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = lngCalculation
  .Cursor = xlDefault
End With

End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Zeiten addieren - komprimieren-----

31 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread