Fragebogenauswertung in eine Tabelle?
12.12.2006 15:52:01
asz
ich habe folgendes Problem: Unten aufgelistetes Makro liest zwar die Antworten aus einem Fragebogen und listet sie in einer Zeile auf, bei einer erneuten Eingabe in den Fragebogen wird aber ein neues Sheet aufgemacht. Mein Ziel wäre, dass die Ergebnisse einfach in der nächsten Zeile der ersten Auswertungsdatei aufgelistet werden - wer kann mir bitte helfen?
Viele Grüße & ganz vielen Dank im voraus
asz
Sub Veranstaltung_neu()
' Veranstaltung_neu Makro
' Makro am 09.11.2006 von kleina aufgezeichnet
' Tastenkombination: Strg+n
Range("B8").Select
Selection.Copy
Sheets("Auswertung").Visible = True
Sheets("Auswertung").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Veranstaltung").Select
Range("B11").Select
Selection.Copy
Sheets("Auswertung").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Veranstaltung").Select
Range("B21").Select
Selection.Copy
Sheets("Auswertung").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Veranstaltung").Select
Range("C45").Select
Selection.Copy
Sheets("Auswertung").Select
Range("AA2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Veranstaltung").Select
Range("B47").Select
Selection.Copy
Sheets("Auswertung").Select
Range("AB2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Veranstaltung").Select
Range("B49").Select
Selection.Copy
Sheets("Auswertung").Select
Range("AC2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Auswertung").Select
Sheets("Auswertung").Copy Before:=Sheets(3)
ActiveWindow.SelectedSheets.Visible = False
Sheets("Auswertung").Visible = False
Sheets("Veranstaltung").Select
ActiveSheet.Shapes("Check Box 2").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 3").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 4").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 9").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 10").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 11").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 12").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 13").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 14").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 15").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 16").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 17").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 23").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 25").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 27").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 28").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 29").Select
With Selection
.Value = xlFalse
End With
ActiveSheet.Shapes("Check Box 30").Select
With Selection
.Value = xlFalse
End With
Range("B8,B11,B21,C45").ClearContents
End Sub