Hallo Tom,

benutze doch Autofilter und kopiere nur die sichtbaren Zellen.

Gruß Hajo

Hallo Hajo,
ich wollte aber eine VBA Lösung, da mehrere Mitarbeiter damit arbeiten, denen Excel nicht so geläufig ist. Trotzdem vielen Dank.
Freundliche Grüße
Tom3

Hallo Tom,

eine VBA-Lösung kannst Du selbst erzeugen, indem Du Hajo's Vorschlag mit dem Makrorecorder aufzeichnest und den entstandenen Code einem Button oder einer Tastenkombination zuweist.

Gruß
Rainer

Hallo Tom,

ein Vorschlag:

Sub Datum_und_Werte_C_Q_kopieren()
Dim bis As Integer, m As String, monat As Date, von As Integer, z As Integer

m = InputBox("Eingabe von Monat und Jahr " & vbCrLf & "in der Form 01.2009 | Januar 2009  | Jan 2009", _
"Eingabe des Monats", CStr(Month(Date)) & "." & CStr(Year(Date)))
monat = DateValue("01." & m)
' Von welcher Zeile bis zu welcher Zeile kopieren?
von = 0
bis = 0
For z = 6 To ThisWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row
  If ThisWorkbook.Worksheets("Tabelle1").Cells(z, 2).Value >= monat Then
    von = z
    monat = DateAdd("m", 1, monat)
    Do
      z = z + 1
    Loop Until ThisWorkbook.Worksheets("Tabelle1").Cells(z, 2).Value >= monat
    bis = z - 1
    Exit For
  End If
Next z
' Daten B[von]:Q[bis] in Tabelle "MMJJ" kopieren
If (5 < von) And (von < bis) Then
  If ThisWorkbook.Worksheets("MMJJ").Cells(1, 2).Value = "" Then
    z = 0
  Else
    z = ThisWorkbook.Worksheets("MMJJ").Cells(Rows.Count, 2).End(xlUp).Row
  End If
  ThisWorkbook.Worksheets("Tabelle1").Range("B" & CStr(von) & ":Q" & CStr(bis)).Copy
  ' eine Leerzeile Zwischenraum lassen
  ThisWorkbook.Worksheets("MMJJ").Range("B" & CStr(z + 2)).PasteSpecial Paste:=xlValues, Operation:=xlNone
  ' direkt unter vorhandene Daten ohne Zwischenraum kopieren
  'ThisWorkbook.Worksheets("MMJJ").Range("B" & CStr(z + 1)).PasteSpecial Paste:=xlValues, Operation:=xlNone
  Application.CutCopyMode = False
  'ThisWorkbook.Worksheets("MMJJ").Select
  'ThisWorkbook.Worksheets("MMJJ").Range("A1").Activate
  'ThisWorkbook.Worksheets("Tabelle1").Select
  ThisWorkbook.Worksheets("Tabelle1").Range("A1").Activate
Else
  MsgBox "Kein Zeitbereich gefunden, es wird nichts kopiert."
End If
End Sub 

MfG Charlotte

Hallo Charlotte,
Entschuldigung, dass ich erst jetzt dazu komme dein Makro zu testen.

If ThisWorkbook.Worksheets("MMJJ").Cells(1, 2).Value = "" Then

Leider bringt das Makro an dieser Stelle einen Fehler ( Index außerhalb des gültigen Bereiches, Laufzeitfehler 9 ). Mir fehlt leider das Wissen herauszufinden, woran das liegen könnte. Kannst Du bzw. jemand mir helfen ? Vielen Dank.
Mfg Tom

Hallo Tom,

das sieht ganz stark danach aus, dass Dein Tabellenblatt, in das die Werte kopiert werden sollen, nicht "MMJJ" heißt, sondern vielleicht "1209" oder so. Allerdings sollte

Überprüfe bei dieser Gelegenheit auch gleich, ob das erste Tabellenblatt, aus dem die Werte kopiert werden sollen, auch tatsächlich "Tabelle1" heißt. Groß-/ Kleinschreibung spielt dabei keine Rolle. Die Tabellenblatt-Namen unten auf den "Reitern" und im VBA-Code müssen übereinstimmen. Am einfachsten kriegst Du das hin, wenn Du im VBA-Editor (mit ALT+F11 öffnen, dann den VBA-Code des Makros anzeigen) die Suchen-und-Ersetzen-Funktion (STRG+H) benutzt und bei

Suchen in:
(*) in der aktuellen Prozedur
[Alle ersetzen]

lässt:

"Tabelle1" --> "Tabellenblatt-Name_der_Quelle"
"MMJJ" --> "" "Tabellenblatt-Name_des_Ziels"

Da ich Deine konkreten Namen nicht weiß und auch nicht, wie variabel (mit zusätzlichen Abfragen?) das Kopieren stattfinden soll, kann ich Dir erstmal nicht weiter helfen. Aber ansonsten sollte der Code laufen, ich habe ihn getestet.

MfG Charlotte

Hallo Charlotte,
ja das stimmt, ich habe mich wohl nicht richtig ausgedrückt. Ich meinte, das die Tabellenblätter mit Monat und Jahr benannt sind, also 1009, 1109 usw.
Hier ist meine Beispieltabelle:
http://www.file-upload.net/download-2064993/Mappe1.xls.html
Es sollen nachdem der entsprechende Monat eingegeben ist, die Werte des Monats in die dazugehörigen Tabellenblätter kopiert werden.
Mit freundlichen Grüßen
Tom

Sorry,

keine Zeit.

http://www.file-upload.net/download-2065060/SN2287203.xls.html

MfG Charlotte

Hallo Tom,

ich habe den Code an die 3 Ziel-Tabellen "1009", "1109", "1209" angepasst, getestet und in Deine Datei kopiert.

Sub Datum_und_Werte_C_Q_kopieren()
Dim bisZ As Integer, m As String, monat As Date, nachZ As Integer, vonZ As Integer, z As Integer
Dim nachTbl As String

m = InputBox("Eingabe von Monat und Jahr " & vbCrLf & "in der Form 01.2009 | Januar 2009  | Jan 2009", _
"Eingabe des Monats", CStr(Month(Date)) & "." & CStr(Year(Date)))
monat = DateValue("01." & m)
' In welche Tabelle "MMJJ" kopieren?
nachTbl = CStr(Month(monat)) & Right(CStr(Year(monat)), 2)
' von welcher Zeile bis zu welcher Zeile kopieren?
vonZ = 0
bisZ = ThisWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row
For z = 6 To ThisWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row
  If ThisWorkbook.Worksheets("Tabelle1").Cells(z, 2).Value >= monat Then
    vonZ = z
    monat = DateAdd("m", 1, monat)
    Do
      z = z + 1
    Loop Until ThisWorkbook.Worksheets("Tabelle1").Cells(z, 2).Value >= monat Or z > bisZ
    bisZ = z - 1
    Exit For
  End If
Next z

' Daten B[vonZ]:Q[bisZ] in Tabelle "MMJJ" kopieren
If (5 < vonZ) And (vonZ < bisZ) Then
  z = ThisWorkbook.Worksheets(nachTbl).Cells(Rows.Count, 2).End(xlUp).Row
  If z = 1 And ThisWorkbook.Worksheets(nachTbl).Cells(1, 2).Value = "" Then z = 0
  ThisWorkbook.Worksheets("Tabelle1").Range("B" & CStr(vonZ) & ":Q" & CStr(bisZ)).Copy
  ' eine Leerzeile Zwischenraum lassen
  ThisWorkbook.Worksheets(nachTbl).Range("B" & CStr(z + 2)).PasteSpecial Paste:=xlValues, Operation:=xlNone
  ' direkt unter vorhandene Daten ohne Zwischenraum kopieren
  'ThisWorkbook.Worksheets(nachTbl).Range("B" & CStr(z + 1)).PasteSpecial Paste:=xlValues, Operation:=xlNone
  Application.CutCopyMode = False
  ThisWorkbook.Worksheets(nachTbl).Select
  ThisWorkbook.Worksheets(nachTbl).Range("A1").Activate
  ThisWorkbook.Worksheets("Tabelle1").Select
  ThisWorkbook.Worksheets("Tabelle1").Range("A1").Activate
Else
  MsgBox "Kein Zeitbereich gefunden, es wird nichts kopiert."
End If
End Sub 

Download-Link: http://www.file-upload.net/download-2067566/SN2287203.xls.html

Es gibt im Code noch eine Wahlmöglichkeit, und zwar, ob oberhalb und - falls mehrmals in ein Tabellenblatt kopiert wird - zwischen den Blöcken eine Leerzeile gelassen wird oder nicht. Was besser ist, hängt sicherlich auch davon ab, was Du insgesamt vorhast und ob Du den Code noch weiterentwickelst. Momentan wird eine Leerzeile gelassen. Um dies zu ändern, müsstest Du
ein Kommentarzeichen ' oder REM vor
ThisWorkbook.Worksheets(nachTbl).Range("B" & CStr(z + 2)).PasteSpecial Paste:=xlValues, Operation:=xlNone
setzen und und das Kommentarzeichen ' vor
'ThisWorkbook.Worksheets(nachTbl).Range("B" & CStr(z + 1)).PasteSpecial Paste:=xlValues, Operation:=xlNone
löschen.

MfG Charlotte

Hallo Charlotte,
habe deinen Code gleich getestet und bin beeindruckt. Genau so habe ich es mir vorgestellt. Vielen Dank für Deine Hilfe und ein schönes Weihnachtsfest.
Freundliche Grüße
Tom