Zellbereich auf Werte prüfen

[omron2003]

Hallo Forum,

mit folgendem Code,
prüfe ich ob in Tabelle1 im Bereich B9:E9 Werte stehen, falls nicht kommte eine MsgBox.
Steht aber in einem der Zellen ein Wert, wird das Macro weiter ausgeführt,
der Bereich B9:E9 aus Tabelle1 wird kopiert und in Tabelle2 Bereich S7:V7 eingefügt.

Mein Problem ist nun folgendes,
in dem Bereich B9:E9 von Tabelle1 stehen Formeln die die Zellen aus Werten anderer Tabellen füllen.
Hier  scheintert mein Macro, es kopiert auch den Bereich wenn keine sichtbaren Werte drin stehen?
In meiner Testmappe wo ich den Code erstellt habe funktioniert es da in den Zellen keine Formeln stehen.

Meine Frage:
wie müsste ich den Code anpassen das es auch bei Formenl funktioniert, bzw. gibt es einen besseren Lösungsweg?

Code:

Sub ACopy04()
'-----------------------------------------------------------------------------------------
'Prüft den Bereich B9:E9 ob Leer
'Wenn Range Leer kommt MsgBox ansonsten wir das Macro weiter ausgeführt.
'-----------------------------------------------------------------------------------------
If Application.WorksheetFunction.CountA(Worksheets("Tabelle1").Range("B9:E9")) = 0 Then
    MsgBox "es macht keinen sinn einen leeren Bereich zu kopieren!"
Else
' Kopiert den Range in Tabelle1
    Range("B9:E9").Select
    Selection.Copy
'Fügt die Werte in Tabelle2 Range S7:V7 ein
    Sheets("Tabelle2").Select
    Range("S7:V7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AB5").Select
End If
End Sub

Besten Dank im Voraus
omron2003

[Kuwer]

Hallo,

so wie es aussieht, ist es doch egal, ob die Zellen etwas anzeigen oder nicht. Also einfach

Code:

Sub ACopy04()
    Sheets("Tabelle2").Range("S7:V7").Value = Sheets("Tabelle1").Range("B9:E9").Value
End Sub

und gut ist.

Gruß Uwe

[omron2003]

Hallo,

das ist nicht das was ich benötige!

vieleicht verdeutlicht die Demo Mappe mein Anliegen.

der Code von Tabelle1 nach Tabelle2 hier funktioniert die Prüfung.
der gleiche Code von Tabelle3 (mit Formeln "SVERWEIS von Tabelle4") nach Tabelle2 hier funktioniert die Prüfung nicht

Besten Dank im Voraus
omron2003

[NobX]

Hallo,

versuche es einmal so:

Code:

Sub CopyA01()

If Application.WorksheetFunction.CountA(Worksheets("Tabelle3").Application.WorksheetFunction.Sum(Range("B3:D3"))) = 0 Then
usw.

Grüße

Norbert

[omron2003]

Hallo,

leider funktioniert es hiermit auch nicht....

Code:

Sub CopyA01()

If Application.WorksheetFunction.CountA(Worksheets("Tabelle3").Application.WorksheetFunction.Sum(Range("B3:D3"))) = 0 Then
   MsgBox " es macht keinen Sinn einen leeren Bereich zu kopieren!"
Else
  Range("B3:D3").Select
   Selection.Copy
  Sheets("Tabelle2").Select
  Range("B3:D3").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Range("A1").Select
End If
End Sub

Gruß
omron2003

[BoskoBiati]

Hi,

einfach so:

Code:

Sub Copy01()

If Application.WorksheetFunction.CountIf(Worksheets("Tabelle1").Range("B3:D3"), "") = 3 Then
   MsgBox " es macht keinen Sinn einen leeren Bereich zu kopieren!"
Else
  Range("B3:D3").Copy
  Sheets("Tabelle2").Range("B3:D3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End If
End Sub

[NobX]

Hallo,

habs noch mal getestet, - so hat es funktioniert:

Code:

Sub CopyA01()

If Application.WorksheetFunction.Sum(Range("B3:D3")) = 0 Then
   MsgBox " es macht keinen Sinn einen leeren Bereich zu kopieren!"
Else
  Range("B3:D3").Select
   Selection.Copy
  Sheets("Tabelle2").Select
  Range("B3:D3").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Range("A1").Select
End If
Application.CutCopyMode = False
End Sub

Grüße

Norbert

[omron2003]

Hallo,

Super, jetzt funktioniert es so wie ich es mir vorgestellt habe.

Nochmals besten Dank an alle für die schnelle Hilfe
LG omron2003