Daten übertragen
03.01.2009 15:31:00
adi
der unten stehende Code funktioniert aber mal richtig
mal werden die Daten nicht an der richten Stelle abgelegt.
Ablauf:
In der Hebeliste wir die Zahl der.Eingabe gesucht, bei Erfolg werden die
Daten, die rechts von der gefundenen Zahl stehen eingelesen.
In ( A1:A32) stehen die Zahlen von 1 bis 32.
Dann werden diese Daten mit zur nächsten Tabelle Ga_33_64
genommen. Dort muß wieder die Zahl der Eingabe gesucht werden,
bei erfolg sollen die Daten dann in den Bereichen abgelegt werden. ENDE
Wie schon erklärt, ist irgend wo ein Fehler. Könnte mir jemand mal diesen
Code überarbeiten, ?
----------------------------------------------------------------------
Sub Garten33_64_Übertragen()
Application.ScreenUpdating = False
Sheets("Hebeliste").Select
Range("A2").Select
ActiveSheet.Unprotect
Mldg = "Soll jetzt der Beitrag übertragen werden ?"
Stil = vbYesNo
Title = "Beitrag wird aus der Hebeliste übertragen"
Prompt = MsgBox(Mldg, Stil, Title)
If Prompt = 7 Then Sheets("Ga_33_64").Select: Exit Sub
GartenNr = InputBox("Garten-Nr. ACHTUNG Zahl zwischen 33 + 64 :", "GartenNr", Selection())
If GartenNr 64 Then: Sheets("Ga_33_64").Select: MsgBox "Die Eingabe ist zu gross": Exit _
_
Sub
Range("A2").Value = GartenNr 'kopiert die Nr in A2
ActiveCell.Offset(1, 0).Select
Hebeliste 'Unterprogramm
PosX = ActiveCell.Address
ActiveCell.Offset(0, 1).Select: BeitragPacht = ActiveCell 'Pacht wird aus der Hebeliste _
_
eingelesen
ActiveCell.Offset(0, 1).Select: BeitragVerein = ActiveCell ' "" usw.
ActiveCell.Offset(0, 1).Select: BeitragStadt = ActiveCell 'eine Stellen nach rechts
ActiveCell.Offset(0, 1).Select: BeitragLand = ActiveCell
ActiveCell.Offset(0, 1).Select: ReinigungVerein = ActiveCell
Range(PosX).Select
Sheets("Ga_33_64").Select
ActiveSheet.Unprotect
Garten33bis64 'Unterprogramm
ActiveCell.Offset(0, 10).Select
ActiveCell.FormulaR1C1 = BeitragPacht 'Beitrag wird nach Tabelle Ga_1_64 kopiert
ActiveCell.Offset(0, 2).Select 'zwei Stellen nach rechts
ActiveCell.FormulaR1C1 = BeitragVerein
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = BeitragStadt
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = BeitragLand
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ReinigungVerein
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True 'Schutz einschalten
Application.StatusBar = "Der Betrag: " & GartenNr & " ist eingetragen worden."
MsgBox "Der Betrag: " & GartenNr & " ist eingetragen worden."
Range("A3").Select
End Sub
Sub Hebeliste() 'Unterprogramm sucht richtige Garten Nr aus
For ZählerA = 33 To 64
' Range("A2").Select
' Range("A2").Value = GartenNr
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = GartenNr Then Exit Sub
' If ActiveCell = GartenNr Then : Exit Sub
Next ZählerA
End Sub
Sub Garten33bis64() 'Unterprogramm sucht richtige Garten Nr aus
Range("A2").Select
Range("A2").Value = GartenNr
ActiveCell.Offset(2, 0).Select
For ZählerC = 33 To 64
ActiveCell.Offset(1, 0).Select 'eine Zeile nach unten
If ActiveCell = GartenNr Then : Exit Sub
Next ZählerC
End Sub