Hallo Excel VBA Profis,
ich bin am Verzweifeln.
Nach stundelanger Suche in den Foren, findet ich keine passende Lösung.
Habe schon einiges versucht, auch zusammenkopierem von VBA Scripts um meienr lösung näher zu kommen. Aber jetzt hängts immer noch.
Ich möchte aus einer Tabelle, bestimmte Werte mit einem definierten Datum in eine neue Tabelle übergeben. (kopieren). Diese werde ich dann monatlich an eine Abteilung senden (Mail).
Leider klappt das "gefundene" Script aber nicht, ich hab es ergänzt um den kopierbefehl, aber es läuft auf fehler.
wer kann mir denn helfen...?
-------------------------------------
Sub Robert()
Dim c As Range, ErgBereich As Range, _
Mon As String, _
laR As Long, _
check As Boolean
Mon = InputBox(vbCr & vbCr & vbCr & "Gesuchter Monat:")
If Mon = "" Then check = True
If IsNumeric(Mon) Then
If Mon 12 Then check = True
Else
check = True
End If
If check = True Then
MsgBox "Keine oder falsche Eingabe !" & vbCr & vbCr & _
"Makro-Abbruch !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 11).End(xlUp).Row
For Each c In Range("A14:K100" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Rows(c.Row)
Exit For
End If
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Nichts gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
Else
For Each c In Range("A14:K20" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Application.Union(ErgBereich, Rows(c.Row))
End If
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
Selection.copy
Sheets("Datenlieferung_ITGBA01_Kopier").Select
Range("A:A").Select
ActiveSheet.SelectionPaste
---------------------------------------------------