Makro läuft nicht richtig
14.02.2008 10:27:00
rene
möcht, wenn im Blatt "Eingabe" - B7, sich das Datum (per Liste, nicht Listenfeld) verändert wird, sollen die zugehörigen Daten aus Blatt "Alle_Wochen" geladen werden. Nun läuft das Makro nicht und wenn mal doch, dann hängt sich Excel auf.
Was ist falsch, hab ich was vergessen oder übersehen? Bitte um Hilfe!
LG rene
Private Sub Worksheet_Change(ByVal Target As Range)
'Verlasse den Code, wenn die geänderte Zelle nicht B7 ist:
If Target.Address "$B$7" Then Exit Sub
'Private Sub CommandButton1_Click()
Dim objEingabe As Worksheet, objDaten As Worksheet
Dim lngR As Long, intC As Integer, lngEingabe As Long
Set objEingabe = Sheets("Eingabe") 'Eingabetabelle
Set objDaten = Sheets("Alle_Wochen") 'Datentabelle
lngR = Sheets("Alle_Wochen").Columns(1).Find(Sheets("Eingabe").Range("B7")).Row
'If ComboBox1.ListIndex -1 Then
' ComboBox1.ListIndex + 2 'Zeile im Blatt Alle_Wochen
For intC = 1 To 91
Select Case intC
'Im Folgenden kann die Prüfung auf Formel im Eingabebereich entfallen, wenn dort keine _
_
Formeln sind!
Case 1 To 16 'Spalten 1 bis 16 (A bis P)
'Daten in B2:B22 eintragen
lngEingabe = 7 '1. Eingabezeile in Spalte B
If Not objEingabe.Cells(lngEingabe + intC - 1, 2).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 1, 2).Value = _
objDaten.Cells(lngR, intC).Value
End If
Case 17 To 31 'Spalten 17 bis 31
'Daten in C3:C22 eintragen
lngEingabe = 8 '1. Eingabezeile in Spalte C
If Not objEingabe.Cells(lngEingabe + intC - 17, 3).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 17, 3).Value = _
objDaten.Cells(lngR, intC).Value
End If
Case 32 To 46 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte D
If Not objEingabe.Cells(lngEingabe + intC - 32, 4).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 32, 4).Value = _
objDaten.Cells(lngR, intC).Value
End If
Case 47 To 61 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte E
If Not objEingabe.Cells(lngEingabe + intC - 47, 5).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 47, 5).Value = _
objDaten.Cells(lngR, intC).Value
End If
Case 62 To 76 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte F
If Not objEingabe.Cells(lngEingabe + intC - 62, 6).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 62, 6).Value = _
objDaten.Cells(lngR, intC).Value
End If
Case 77 To 91 'Spalten
lngEingabe = 8 '1. Eingabezeile in Spalte G
If Not objEingabe.Cells(lngEingabe + intC - 77, 7).HasFormula Then
objEingabe.Cells(lngEingabe + intC - 77, 7).Value = _
objDaten.Cells(lngR, intC).Value
End If
End Select
Next
'Unload Me
End Sub
Hoffe der Code ist lesbar!