Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

klappt nicht.....

klappt nicht.....
31.10.2007 20:08:00
Heiko
Hallo, könnt ihr mir helfen?
Thanks @Chris für die Hilfe bisher!!!!
Diese Code soll eine Datenblatt "Auswertung" überprüfen Zeile für Zeile ob in Spalte Q6:Q31 ein WAHR steht, wenn ja dann kopiert er Zellen B6:B14 usw betroffene Zeile in ein neues Datenblatt "Auswahl". Diese geschieht, in dem der 1. Eintrag in B6 ist und immer eine Zeile eingefügt wird und fortlaufender Nummerierung.
Aber es klappt nicht so ganz!
1. in dem neuen Blatt wird nicht wie gewünscht in B6 begonnen sondern schon in A2
2. Dei Durchnummerierung passt nicht, bedeutet in Zeile 1 sind Einträge aber Zähler beginnt mit 1 in Zeile 2 und beginnt nach 4 wieder mit 1 ( hat das was mit der row=5 zu tun?
3. Die Formatierung pass nicht. der letzte Eintrag ist der erste in dem neuen Sheet

Sub Auswahlt()
Dim zeile As Long, letzte As Long, letzteB As Long
For zeile = 6 To 31
If Cells(zeile, 17).Value = True Then
If Sheets("Auswahl").Range("A65536").End(xlUp).Row = 5 Then
Range(Cells(zeile, 2), Cells(zeile, 14)).Copy Sheets("Auswahl").Range("B6")
Sheets("Auswahl").Range("A6").Value = 1
Else
Range(Cells(zeile, 2), Cells(zeile, 14)).Copy
Sheets("Auswahl").Range("B65536").End(xlUp).Offset(0, 0).Insert
letzte = Sheets("Auswahl").Range("A65536").End(xlUp).Row
Sheets("Auswahl").Range("A" & letzte + 1).Value = Sheets("Auswahl").Range("A" & letzte) _
.Value + 1
Application.CutCopyMode = False
End If
End If
Next zeile
End Sub



Private Sub CommandButton1_Click()
Call Auswahlt
End Sub


Danke für die Hilfe!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: klappt nicht.....
31.10.2007 21:07:23
Heiko
Hi
habe es etwas angepasst jetzt fängt er richtig an und kopiert die erste wahr Zellen
geht aber nicht in die nächste Zeile oder nummeriert durch in Spalte A
Sub Auswahlt()
Dim zeile As Long, letzte As Long
For zeile = 6 To 31
If Cells(zeile, 17).Value = True Then
If Sheets("Auswahl").Range("A65536").End(xlUp).Row > 5 Then
Range(Cells(zeile, 2), Cells(zeile, 14)).Copy.Sheets("Auswahl").Range ("B6")
Sheets("Auswahl").Range("A6").Value = 1
Else
Range(Cells(zeile, 2), Cells(zeile, 14)).Copy Sheets("Auswahl").Range("B65536").End(xlUp).Offset(5, 0)
letzte = Sheets("Auswahl").Range("A65536").End(xlUp).Row.Paste
Sheets("Auswahl").Range("A" & letzte + 1).Value = Sheets("Auswahl").Range("A" & letzte).Value + 1
End If
End If
Next zeile
End Sub



Private Sub CommandButton1_Click()
Call Auswahlt
End Sub


Anzeige
AW: klappt nicht.....
31.10.2007 22:11:00
Herby
Hallo Heiko,
probiers mal so:
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = Worksheets("Auswertung")
Set wks2 = Worksheets("Auswahl")
Dim zeile As Long, zz As Long, letzte As Long, letzteB As Long
For zeile = 6 To 31
If wks1.Cells(zeile, 17).Value = True Then
If wks2.Range("B65536").End(xlUp).Row < 6 Then
zz = 6
wks1.Range(wks1.Cells(zeile, 2), wks1.Cells(zeile, 14)).Copy _
Destination:=wks2.Range("B" & zz)
wks2.Range("A" & zz).Value = 1
Else
zz = wks2.Range("B65536").End(xlUp).Row + 1
wks1.Range(wks1.Cells(zeile, 2), wks1.Cells(zeile, 14)).Copy _
Destination:=wks2.Range("B" & zz)
wks2.Range("A" & zz).Value = zz - 5
End If
Application.CutCopyMode = False
End If
Next zeile
End Sub
Viele Grüße
Herby

Anzeige
AW: klappt nicht.....
31.10.2007 22:32:34
Heiko
Hi Herby!
Vielen dank klappt bestens!!!!
Jetzt hätte ich aber noch zwei kleiner Probleme:
1. ist es möglich das anstatt dem kopieren neue Zellen einfügen, damit unter dem letzten Eintrag die Summe stehen kann?
2. Die Zellen Farben werden mit übernommen, kann man die komplett entfernen und jede 2. Zeile neu einfärben?
Vielen Dank für die Hilfe
Gruß,
Heiko

AW: klappt nicht.....
31.10.2007 23:28:00
Herby
Hallo Heiko,
was meinst Du zu dieser Lösung ?
Endsumme wird per makro eingetragen und jede 2. Zeile eingefärbt.
Die Zell-Formate werden dagegen nicht mehr übertragen.
</p><pre>Sub Auswahlt()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Set wks1 = Worksheets("Auswertung")
Set wks2 = Worksheets("Auswahl")
Dim zeile As Long, zz As Long, letzte As Long, letzteB As Long
Dim strFormel As String, intSpalte As Integer
Application.ScreenUpdating = False
For zeile = 6 To 31
If wks1.Cells(zeile, 17).Value = True Then
If wks2.Range("B65536").End(xlUp).Row < 6 Then
zz = 6
wks1.Range(wks1.Cells(zeile, 2), wks1.Cells(zeile, 14)).Copy
wks2.Range("B" & zz).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
wks2.Range("A" & zz).Value = 1
Else
zz = wks2.Range("B65536").End(xlUp).Row + 1
wks1.Range(wks1.Cells(zeile, 2), wks1.Cells(zeile, 14)).Copy
wks2.Range("B" & zz).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
wks2.Range("A" & zz).Value = zz - 5
End If
Application.CutCopyMode = False
End If
Next zeile
' Endsumme pro Spalte eintragen
strFormel = "=summe(Z(" & -zz + 6 & ")S:Z(-1)S)"
For intSpalte = 2 To 14
wks2.Cells(zz, intSpalte).FormulaR1C1Local = strFormel
Next
' Zeilen einfärben
For zeile = 6 To zz Step 2
For intSpalte = 2 To 14
wks2.Cells(zeile, intSpalte).Interior.ColorIndex = 6
Next
Next
Application.ScreenUpdating = True
End Sub</pre><p>
Viele Grüße
Herby

Anzeige
AW: klappt nicht.....
31.10.2007 22:36:13
Heiko
Hi Herby,
ich schon wieder!
Die Daten der Auswertung ergeben sich durch Formeln!
Ist machbar das die Werte einfach kopiert werden anstatt der Formeln?
Danke

AW: klappt nicht.....
31.10.2007 23:34:00
Herby
Hallo Heiko,
um die Formeln durch Werte beim kopieren zu ersetzen, brauchst du nur bei
dem letzten Makro diese Konstante:
xlPasteFormulasAndNumberFormats
durch:
xlPasteValuesAndNumberFormats
ersetzen.
Viele Grüße
Herby

AW: klappt nicht.....
01.11.2007 09:11:04
Heiko
Hi,
vielen Dank für die Hilfe!!!!
Gruß, Heiko

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige