Office: Markierte Zellen in anderes Tabellenblatt kopieren

Hallo,

ich habe folgendes Problem:

Ich habe ein Tabellenblatt "Fragebogen", in dem verschiedene Fragen mit einem "X" markiert werden. Eine Userform fragt dann nur die markierten Fragen ab und schreibt die Ergebnisse zurück in das Tabellenblatt.

Zur weiteren Auswertung möchte ich nun alle markierten Fragen mit den dazugehörigen Einträgen in ein anderes Tabellenblatt "Auswertung" kopieren.

dazu benutze ich folgende Methode:

Sub auswertung()


Dim gestellte_fragen As Integer
Dim i As Integer
Dim r As Integer

If i = 0 Then
i = 1
End If

gestellte_fragen = Sheets("Fragenkatalog").UsedRange.Rows.Count

For r = i + 1 To gestellte_fragen
If Sheets("Fragenkatalog").Cells(r, 1).Value = "X" Then
i = r
Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 2).Select
Sheets("Fragenkatalog").Cells(r, 2).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 1).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 3).Select
Sheets("Fragenkatalog").Cells(r, 3).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 2).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 4).Select
Sheets("Fragenkatalog").Cells(r, 4).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 3).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 5).Select
Sheets("Fragenkatalog").Cells(r, 5).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 4).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 6).Select
Sheets("Fragenkatalog").Cells(r, 6).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 5).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 7).Select
Sheets("Fragenkatalog").Cells(r, 7).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 6).Select
Sheets("Auswertung").Paste

Sheets("Fragenkatalog").Select
Sheets("Fragenkatalog").Cells(r, 8).Select
Sheets("Fragenkatalog").Cells(r, 8).Copy
Sheets("Auswertung").Select
Sheets("Auswertung").Cells(2, 7).Select
Sheets("Auswertung").Paste
End If

If r = gestellte_fragen Then
Exit Sub
End If
Next r


End Sub



Das funktioniert auch soweit, dass etwas kopiert wird, aber leider immernur die letzte markierte Zeile... was mache ich falsch?


Vielen Dank schonmal für eure Hilfe!!!

Gruß
das_krümelchen

:)

 

hallo
hab keine loesung,da jetzt Feierabend. Aber vorschlag:
Den Code kann man noch gut kuerzen.
statt
'Sheets("Fragenkatalog").Cells(r, 2).Select
'Sheets("Fragenkatalog").Cells(r, 2).Copy
'Sheets("Auswertung").Select
'Sheets("Auswertung").Cells(2, 1).Select
'Sheets("Auswertung").Paste

reicht
Sheets("Fragenkatalog").Cells(r, 2).Copy Sheets("Auswertung").Cells(2, 1)
gruss hary

 

Das verkürzt auf jeden Fall schon mal den Quellcode^^

Danke!

 

Hallo
schaue nachher noch mal rein, vlt. findet sich doch noch jemand der den Code umschreibt.
gruss hary

 

Hallo,

teste mal so:

Code:

 

WOHA... das funktioniert *Smilie Danke!!!

 

Hi
einen habe ich noch ;-)
Du willst doch nur die X'en in SpalteA haben. Dann brauchst Du den Code nicht so lange(UsedRange) laufen zu lassen, es reicht die Zeile mit dem letzten X in SpalteA. Stell dir vor Du hast nur in den ersten 10 Zeilen ein X und UsedRange hat 15000 Zeilen.
Code:

so sollte es klappen.
gruss hary

 

Mit der anderen Lösung war ich eigentlich schon ganz zufrieden.
Ich will auch nicht nur die X haben, sondern nur die zeilen, die mit X markiert sind, und die sind jedes mal unterschiedlich und können auch noch ganz unten stehen.

Aber trotzdem vielen Dank für deine Hilfe!

 

Hi
Das meine ich. mein Code laeuft bis zum letzten X in SpalteA, egal wo es steht. Mit den 10 Zellen war nur in Beispiel. Dh. mit UsedRange laeuft der Code weiter obwohl keine X'en mehr vorkommen. Meiner hoert auf wenn kein X mehr kommt.
gruss hary
Beispiel

Tabellenblattname: Tabelle1

	A	B	C
1
2	x
3	x
4
5	x
6
7	x	<--bis hier meine Schleife 7 mal
8
9
10
11
12		a	<--bis hier UsedRange Schleife 12 mal

 

Ok, vielen dank *Smilie
hab ich grad mal ausprobiert, klappt auch *Smilie


Danke für eure Hilfe!!!

 

Eine Frage nochmal... was macht Application.ScreenUpdating = False ?

 

Hallo
das macht: Verhindert dass das Bild bei vielen Daten nicht wackelt oder aehnliches.
Also der Bildschirm wird erst nach beenden des Codes aktuellisiert.
daher erst false dann wieder True
gruss hary

 

ok, dann weiß ich bescheid.

Du hast mir echt unglaublich viel geholfen, danke!!!!

 

.....

 

du natürlich auch uwe!!!