AW: nein, Doppelklick auf Tabellenblatttnamen o.w.T.
03.12.2005 18:11:54
Reinhard
Hi Karin,
nachfolgender Code ist ungetestet. Falls Fehler auftreten, brauch ich Fehlernummer und die Zeile wo der gelbe Debugger steht wenn du auf Debuggen im Editor klickst.
Zellen zu verbinden bringt meistens nix als Ärger, warum sind C--K verbunden?
Warum wird beim Schließen des Datenblattes C4:K4 selectiert?
Activate und Seect braiucht man zu 99% nie.
Mein erstes Makrto wäre zum Einsatz gekommen, natürlich angepasst, wenn du einen Automatismus gebraucht hättest dass, wenn alle Zeilen in C4:C52 gefüllt sind diese Daten automatisch abgespeichert würden und dann Spalte C wieder gelöscht wird.
Gruß
Reinhard
Option Explicit
Sub Abspeichern()
Call Eintragen
Call UnterNamenSpeichern
End Sub
Sub Eintragen()
'Das Makro übertragt die Daten vom MA Datenblatt in die geschlossene DAtei MA Übersicht.
'Das Datum in Zelle C36 wird geprüft und anhand der Monats- und Jahreszahl in die
'entsprechende MA Übersicht (Januar bis Dezember) eingetragen.
Dim wksSource As Worksheet, wksTarget As Worksheet, iRow As Long 'Integer geht nur bis 32...
Dim blatt As Worksheet
On Error GoTo Dateifehler
Workbooks.Open Filename:="c:\Übersicht.xls"
Set wksSource = Workbooks("Datenblatt.xls").Worksheets("MA Datenblatt")
iRow = wksSource.Range("A65536").End(xlUp).Row + 1
blatt = "Übersicht " & MonthName(Month(wksSource.Range(C36)), True) & " " & CStr(Year(Range(C36)))
With Workbooks("Übersicht.xls").Worksheets(blatt)
On Error GoTo Fehler
'.Unprotect
wksSource.Range(Cells(4, 3), Cells(5, 3)).Copy Destination:=.Cells(iRow, 1)
wksSource.Range(Cells(35, 3), Cells(35, 3)).Copy Destination:=.Cells(iRow, 3)
wksSource.Range(Cells(19, 3), Cells(5, 3)).Copy Destination:=.Cells(iRow, 4)
wksSource.Range(Cells(9, 3), Cells(10, 3)).Copy Destination:=.Cells(iRow, 5)
wksSource.Range(Cells(26, 3), Cells(5, 3)).Copy Destination:=.Cells(iRow, 7)
wksSource.Range(Cells(42, 3), Cells(45, 3)).Copy Destination:=.Cells(iRow, 8)
wksSource.Range(Cells(36, 3), Cells(5, 3)).Copy Destination:=.Cells(iRow, 12)
'.Protect
End With
Exit Sub
Fehler:
MsgBox "Fehler"
Exit Sub
Dateifehler:
MsgBox "Dateifehler"
End Sub
End If
End Sub
' Das Makro speichert das MA Datenblatt unter dem Namen des Klienten, die Einträge
' der Originaldatei werden gelöscht, das MA Datenblatt wird beim nächsten Aufruf
' wieder leer zur Verfügung gestellt.
Sub UnterNamenSpeichern()
' Datei kopieren und MA Datenblatt.xls leeren
ThisWorkbook.SaveCopyAs Filename:="C:\Personalinnovation\Mitarbeiter in Beratung\" & Range("C4") & "_" & Range("C5") & ".xls"
ActiveSheet.Unprotect
ActiveSheet.Range("C1:K52").ClearContents
'*** Zelle B1 auch leeren
Range("B1").ClearContents
Range("C4:J4").Select '??
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks.Close savechanges:=True
End Sub