Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
900to904
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
900to904
900to904
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nicht-leere Zellen kopieren

Nicht-leere Zellen kopieren
27.08.2007 07:28:17
Ralf
Hallo an alle.
Ich plage mich gerade mit den Heldentaten meines Vorgängers. :) Und zwar hat jener eine wenig brauchbare Tabelle entworfen, in der alle Mitarbeiter je nach Arbeitsstelle in einer Zeile stehen, anstatt in einer Spalte. Mittlerweile gibt es mehr Mitarbeiter als Spalten, daher: Problem. ;)
Ich habe mich gerade an VBA versucht, die die Mitarbeiter aus der alten Datei in die neue kopieren soll. Das ganze sieht wie folgt aus:

Sub Transfer()
Dim n As Integer                                    'Spalte
Dim m As Integer                                    'Zeile
Dim r As Integer                                    'Lauf-Index für Zieldatei
Application.ScreenUpdating = False
r = 5
For m = 4 To 208 Step 1                             'Zeilen 4 bis 208
For n = 20 To 49 Step 1                      'Spalten T bis AW
Workbooks("Head Count Report OLD.xls").Activate
Sheets("Headcount").Activate
If Cells(m, n)  "" Then                     'Falls Zelle NICHT leer
Cells(m, n).Copy                              'kopieren und
Windows("Head Count NEW.xls").Activate
Sheets("Headcount").Activate
Cells(r, 4).PasteSpecial                   'in "NEW" unterhalb D5 eintragen
n = n + 1
r = r + 1
Else
n = n + 1
End If
Next n
m = m + 1
Next m
End Sub


Amüsanter - und mir leider unverständlicherweise, werden allerdings wahlfrei irgendwelche Werte übernommen. (Ich kann jedenfalls kein Muster erkennen.) Wie es eigentlich funktionieren sollte war: Ab Zeile 4 von Spalte T bis AW jede Zelle durchgrasen. Wenn sie einen Namen enthält, soll dieser kopiert werden und in Datei "Head Count NEW.xls" ab Spalte D5 eingefügt werden. Naja, leider kommt aber nur ein viertel der Daten an... :(
Weiß jemand Rat? Die besten Grüße aus Japan,
Ralf

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nicht-leere Zellen kopieren
27.08.2007 07:46:00
Coach
Hallo Ralf,
Du solltest die
m=m+1 und n=n+1 löschen, da Du schon For m und For n-Schleifen benutzt.
Statt .Copy .. wäre besser/schneller:
Windows("Head Count NEW.xls").Sheets("Headcount").Cells(r, 4).value = cells(m,n).value
Also ungefähr so:
Application.ScreenUpdating = False
Workbooks("Head Count Report OLD.xls").Activate
Sheets("Headcount").Activate
r = 5
For m = 4 To 208 Step 1
For n = 20 To 49 Step 1
If Cells(m, n) "" Then
Windows("Head Count NEW.xls").Sheets("Headcount").Cells(r, 4).value = cells(m,n).value
r = r + 1
End If
Next n
Next m
Application.ScreenUpdating = True
Außerdem verstehe ich nicht, warum jetzt alle Werte untereinander stehen sollen, müßten die Werte nicht eher in Zeilen angeordnet werden.
Gruß Coach

Anzeige
AW: Nicht-leere Zellen kopieren
27.08.2007 07:58:00
Ralf
Hm... der Code sieht soweit schonmal wesentlich besser aus als meiner und ist auch verständlicher. Danke soweit.
Allerdings erscheint folgende Fehlermeldung bei der Ausführung von:
Windows("Head Count NEW.xls").Sheets("Headcount").Cells(r, 4).Value = Cells(m, n).Value
Runtime Error '438':
Object doesn't support this property or method
Woran könnte das liegen?
Achso... bezüglich deiner Frage: Die Mitarbeiter stehen jetzt untereinander, da es nicht genug Spalten gibt. Bisher ist es ja so, das alle Mitarbeiter (eines Geschäftsbereiches) nebeneinander in einer Zeile stehen. Das reicht mittlerweile nicht mehr aus... :(

Anzeige
AW: Nicht-leere Zellen kopieren
27.08.2007 09:14:05
Beverly
Hi ralf,
versuche es mal hiermit

Sub Transfer()
Dim n As Integer                                    'Spalte
Dim m As Integer                                    'Zeile
Dim r As Integer
r = 5
Application.ScreenUpdating = False
For m = 4 To 208                             'Zeilen 4 bis 208
For n = 20 To 49                      'Spalten T bis AW
With Workbooks("Head Count Report OLD.xls").Worksheets("Headcount")
If .Cells(m, n)  "" Then                     'Falls Zelle NICHT leer
.Cells(m, n).Copy                              'kopieren und
Workbooks("Head Count NEW.xls").Worksheets("Headcount").Cells(r, 4). _
PasteSpecial Paste:=xlValues                   'in "NEW" unterhalb D5 eintragen
r = r + 1
End If
End With
Next n
Next m
Application.ScreenUpdating = True
End Sub


________________________________________

Anzeige

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige