Zellbereich mit Inhalt & Formatierung untereinander kopieren

Question

Hallo Excel Community, :)

hier meine Problemstellung:

In der Tabelle 1 gibt es eine Spalte F. Diese beinhaltet pro Zeile ein Wort "Ja"...irgendwann kommt eine Zeile mit "Nein". Es soll errechnet werden wieviele Zeilen mit Ja in jener Spalte vorkommen, damit man weiß wie oft der Zellbereich (A1:AH34) mit Inhalt und Formatierung aus der Tabelle 2 in eine Tabelle 3 untereinander kopiert werden soll.

Ein Beispiel:

A B C D E F
1 Ja
2 Ja
3 Ja
4 Nein

-> Tabelle1: Ja kommt 3x vor -> Zellbereich (A1:AH34) von Tabelle 2 soll 3x in die Tabelle 3 untereinander kopiert werden.

An sich keine große Sache, nur leider reichen meine VBA Kenntnisse nicht...drum Danke im Voraus für Eure Hilfe.

Grüße, Tom

Answer 1

oops...die Ja's und das Nein im Beispiel oben sollten bei F stehen. :)

Answer 2

Hi Tom,

meinst du das so:

Sub Kopieren()
Dim raZelle As Range
Dim loLetzte As Long
Set raZelle = Worksheets("Tabelle2").Columns("F").Find("Nein", lookat:=xlWhole)
If Not raZelle Is Nothing Then
With Worksheets("Tabelle3")
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Tabelle2").Range("A1:AH" & raZelle.Row - 1).Copy .Cells(loLetzte, 1)
Worksheets("Tabelle2").Range("A1:AH" & raZelle.Row - 1).Copy .Cells(loLetzte + raZelle.Row - 1, 1)
Worksheets("Tabelle2").Range("A1:AH" & raZelle.Row - 1).Copy .Cells(loLetzte + (raZelle.Row - 1) * 2, 1)
End With
End If
End Sub

Bis später,
Karin

Answer 3

Sieht auf den ersten Blick danach aus, was ich suche...

...doch hab ich ne Frage:

warum hast Du hier...

Set raZelle = Worksheets("Tabelle2").Columns("F").Find("Nein", lookat:=xlWhole)

...Tabelle 2 genommen, wenn in Tabelle 1 die Ja Werte sind?

Gruß, Tom

Answer 4

Hi Tom,

sorry, aber es ist nicht ganz so leicht, wenn man die Arbeitsmappe nicht vor sich hat.

Sub Kopieren()
Dim raZelle As Range
Dim loLetzte As Long
Set raZelle = Worksheets("Tabelle1").Columns("F").Find("Nein", lookat:=xlWhole)
If Not raZelle Is Nothing Then
With Worksheets("Tabelle3")
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 6)), .Cells(.Rows.Count, 6).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Tabelle2").Range("A1:AH34").Copy
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 6)), .Cells(.Rows.Count, 6).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Tabelle2").Range("A1:AH34").Copy .Cells(loLetzte, 1)
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 6)), .Cells(.Rows.Count, 6).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Tabelle2").Range("A1:AH34").Copy .Cells(loLetzte, 1)
End With
End If
End Sub

Bis später,
Karin

Answer 5

Hat leider nicht funktioniert. Ist nix passiert.

Gruß,
Tom

Answer 6

Hi Tom,

kann ich leider nicht nachvollziehen - in meiner nachgebauten Mappe funktioniert der Code problemlos - also muss in meiner Mappe etwas anders sein als in deiner und ohne sie zu kennen kann ich das nicht prüfen. Wenn nichts kopiert wird, steht in dem zu kopierenden Bereich entweder nichts drin, oder in Spalte F der Tabelle1 kommt das Wort "Nein" nicht vor (das war ja die Bedingung um die Anzahl festzulegen).

Bis später,
Karin

Answer 7

Passt schon...hab das Problem bei mir gelöst, wenn auch mein Code sicherlich Anfängerhaft aussieht. :)

Aber ich hab viel gelernt. Trotzdem danke ich Dir für deine Müh.

Viele Grüße,
Tom