Anzeige
Archiv - Navigation
380to384
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
380to384
380to384
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nur bestimmte Zellen kopieren

Nur bestimmte Zellen kopieren
11.02.2004 08:56:20
Markus
Hallo Zusammen,
Ich habe da ein Problem mit einer VBA-Prozedur.
Ich habe ein Tabellenblatt mit mehreren Spalten. In den ersten 6 stehen Angaben wie Namen u.s.w.
Dann kommt jeweils eine Spalte mit Stunden und dann mit Kosten für alle Monate des Jahres.
Die Tabelle wollte ich nun so gestalten das nicht alle Werte nebeneinander stehen sondern untereinander.
Sprich immer die ersten 6 Spalten (mit den Namen) und dann immer untereinander die Monate.
Das hab ich soweit auch geschafft. Allerdings Habe ich eine Auswahl getroffen das nur die Zeilen kopiert
werden die auch eine bestimmte Anforderung erfüllen.
Nun mein Problem:
Wenn ich meine Prozedur wie oben ausführe dann schreibt er mit wie ich es dem Rechner gesagt
habe die verglichenen Zelle auch wieder in die entsprechende Zelle auf dem neuen Tabellenblatt.
Die wollte ich dann wieder löschen. Das tut er auch allerdings braucht er dafür echt verdammt lang.
1. Kann man das beschleunigen?
oder 2. Kann man meinen Code so umändern das er die Leerzeilen nicht druckt?
Hier mein Code:

Sub Konverter()
Dim i As Long, lar As Long
Dim ActiveSheets As Worksheet
Dim x As Integer
Dim rg As Range
Dim ws1 As Worksheet
On Error GoTo Err_Konverter
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gesamtübersicht"
Sheets("Std-Erfassung").Select
lar = Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lar
If Not IsEmpty(Sheets("Std-Erfassung").Cells(i, 6).Value) And Not IsEmpty(Sheets("Std-Erfassung").Cells(i, 7).Value) Or Not IsEmpty(Sheets("Std-Erfassung").Cells(i, 8).Value) Then
'Januar
Sheets("Gesamtübersicht").Cells(i, 1).Value = Sheets("Std-Erfassung").Cells(i, 1).Value
Sheets("Gesamtübersicht").Cells(i, 2).Value = Sheets("Std-Erfassung").Cells(i, 2).Value
Sheets("Gesamtübersicht").Cells(i, 3).Value = Sheets("Std-Erfassung").Cells(i, 3).Value
Sheets("Gesamtübersicht").Cells(i, 4).Value = Sheets("Std-Erfassung").Cells(i, 4).Value
Sheets("Gesamtübersicht").Cells(i, 5).Value = Sheets("Std-Erfassung").Cells(i, 5).Value
Sheets("Gesamtübersicht").Cells(i, 6).Value = Sheets("Std-Erfassung").Cells(i, 6).Value
Sheets("Gesamtübersicht").Cells(i, 7).Value = Sheets("Std-Erfassung").Cells(i, 7).Value
Sheets("Gesamtübersicht").Cells(i, 8).Value = Sheets("Std-Erfassung").Cells(i, 8).Value
End If
Next i
Sheets("Gesamtübersicht").Select
Set ws1 = Worksheets("Gesamtübersicht")
Set rg = ws1.Range("A6980")
For x = 1 To rg.End(xlUp).Row - 1
If IsEmpty(Cells(x, 1).Value) And IsEmpty(Cells(x, 2).Value) Then
Rows(x & ":" & x).Delete Shift:=xlUp
x = x - 1
End If
Next x
Exit_Konverter:
Exit Sub
Err_Konverter:
MsgBox Err.Description
Resume Exit_Konverter
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nur bestimmte Zellen kopieren
11.02.2004 12:53:02
Markus
Hallo Zusammen,
habe mein Problem selbst gelöst. Tja wie schon so oft war so:"Kaum macht man es richtig,
schon funktionierts!" :-)
Hatte mich in eine Endlosschleife programmiert.
So haut es besser hin.
intRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = intRow To 1 Step -1
If IsEmpty(Sheets("Gesamtübersicht").Cells(x, 1).Value)_
And IsEmpty(Sheets("Gesamtübersicht").Cells(x, 2).Value) Then_
Cells(x, 1).EntireRow.Delete

Next x
MfG
Markus
Anzeige

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige