Clever-Excel-Forum

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

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

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

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

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

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

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

Hallo,

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

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

omron2003

Kuwer

omron2003

NobX

omron2003

BoskoBiati

NobX

omron2003