Bereich kopieren wenn Bedingung erfüllt

[Peter]

Hallo zusammen,

ich benutze Excel 2003 und habe folgendes Problem: Im Bereich A2:A500
stehen Formeln, die ich per Makro in den Bereich B2:AG500 kopieren
möchte, allerdings nur, wenn im Bereich B1:AG1 etwas steht. Beispiel:
Zelle B1 ist ausgefüllt, also sollen die Formeln in B2:B500 kopiert
werden; Zellen C1:D1 sind leer, also soll hier nichts in C2:D500
kopiert werden; E1 ist wieder ausgefüllt, also sollen die Formeln in
E2:E500 kopiert werden, usw.

Danke schonmal für die Hilfe!

Beste Grüße,
Peter

[Andreas Killer]

Post by Peter
ich benutze Excel 2003 und habe folgendes Problem: Im Bereich A2:A500
stehen Formeln, die ich per Makro in den Bereich B2:AG500 kopieren

Sub Test()
Dim Quelle As Range, Zielspalten As Range, R As Range
Set Quelle = Range("A2:A500")
Set Zielspalten = Range("B1:AG1")
For Each R In Zielspalten
If Not IsEmpty(R) Then
Quelle.Copy
R.Offset(1, 0).Resize(Quelle.Rows.Count).PasteSpecial
xlPasteFormulas
End If
Next
Application.CutCopyMode = False
End Sub

[Peter Schleif]

Post by Peter
ich benutze Excel 2003 und habe folgendes Problem: Im Bereich A2:A500
stehen Formeln, die ich per Makro in den Bereich B2:AG500 kopieren
möchte, allerdings nur, wenn im Bereich B1:AG1 etwas steht.

Sub BereichKopierenWennBedingungErfuellt()
Dim zelle As Range

For Each zelle In [B1:AG1]
If Trim(zelle) <> "" Then
[A2:A500].Copy
zelle(2).Resize(499).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
End If
Next
End Sub


Zusätzlich kannst Du bei leerer Zelle in [B1:AG1] den Bereich darunter
ebenfalls leeren:

If Trim(zelle) <> "" Then
'...
Else
zelle(2).Resize(499).ClearContents
End If

Peter

[Peter]

Post by Peter Schleif

Post by Peter
ich benutze Excel 2003 und habe folgendes Problem: Im Bereich A2:A500
stehen Formeln, die ich per Makro in den Bereich B2:AG500 kopieren
möchte, allerdings nur, wenn im Bereich B1:AG1 etwas steht.

Sub BereichKopierenWennBedingungErfuellt()
   Dim zelle As Range
   For Each zelle In [B1:AG1]
      If Trim(zelle) <> "" Then
         [A2:A500].Copy
         zelle(2).Resize(499).PasteSpecial xlPasteFormulas
         Application.CutCopyMode = False
      End If
   Next
End Sub
Zusätzlich kannst Du bei leerer Zelle in [B1:AG1] den Bereich darunter
      If Trim(zelle) <> "" Then
         '...
      Else
         zelle(2).Resize(499).ClearContents
      End If
Peter

Danke für die schnellen Antworten und eure Hilfe.

@Peter: klappt einwandfrei.
@Andreas: klappt nur beim ersten Eintrag, danach kommt die Meldung
"Objekt erforderlich".

Beste Grüße,
Peter