PDA

Vollständige Version anzeigen : Werte aus Tabelle lesen und für Kopierbefehl verwenden


oneofus79
28.04.2009, 16:29
Hallo,

ich muss eine Arbeitsmappe mit vielen gleich aufgebauten Tabellen
(Bsp. Tabelle1 bis Tabelle 4) immer auf die gleiche Art umkopieren
zwecks Monatsumstellung (in der Datei beispielhaft mit Jahresumstellung).

Ich kopiere dabei etliche Spalten in andere - beispielsweise von Spalte
D in C und von C in B.
Normalerweise kann man so etwas bequem per Mehrfachselektion erledigen
oder gegebenfalls mit einem simplen Makro wie ich es bisher verwendet habe
(siehe unten).
Das Workbook ist jedoch ziemlich groß geworden (viele Spalten häufig auf Tagesbasis und viele Zeilen mit Formeln dazwischen, die deshalb einzeln kopiert werden müssen), so dass diese individuellen Kopieraktionen bis zu 3000x anfallen.

Ich habe mir in der Tabelle "Copy-Befehl" in Spalte B jeweils die Quelle und in der Spalte C die Zielkoordinaten für meine Kopieraktion aufgeschrieben
(Das Original enthält 3000-Aktionen).

Leider bin ich ratlos, wie ich meinen Code in einen Loop verwandeln kann
so dass der Code auf beliebig viele Einlesewerte anwendbar ist.
Bisher muß ich für jede einzelne Zeile und Spalte einen neue Definition etc
eingeben.

Hat jemand eine Idee? Mit Loops, etc. kenne ich mich noch nicht aus :( .

VG,
Emos


Sub ZellenCopy()

Dim WbDatei1 As Workbook

Dim Action01Quelle As String
Dim Action01Ziel As String

Set WbDatei1 = ThisWorkbook

Action01Quelle = WbDatei1.Worksheets("CopyBefehl").Cells(4, "B").Value 'Einlesen der Zellenwerte aus Tabelle
Action01Ziel = WbDatei1.Worksheets("CopyBefehl").Cells(4, "C").Value 'Einlesen der Zellenwerte aus Tabelle

'MsgBox (Action01Quelle) 'Ausgabe von eingelesen Daten zum Testen

'Input Sheets mehrfach auswählen
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle4")).Select
'In die erste Tabelle springen
Sheets("Tabelle1").Activate
'01. Bereich auswählen und in Zwischenspeicher kopieren
Range(Action01Quelle).Select
' Range("C3:C4").Select
Selection.Copy
'01. Zielbereich auswählen und einfügen
Range("B3:B4").Select
ActiveSheet.Paste
'02. Bereich auswählen und in Zwischenspeicher kopieren
Range("C6:C7").Select
' Application.CutCopyMode = False
Selection.Copy
'01. Zielbereich auswählen und einfügen
Range("B6:B7").Select
ActiveSheet.Paste
End Sub

NoNet
28.04.2009, 16:45
Hallo Emos,

das ist einfacher und kürzer als man denkt :

Sub ZellenCopyNoNet()
Dim WbDatei1 As Workbook
Dim lngZ As Long 'Zeilenindex

Set WbDatei1 = ThisWorkbook

'Input Sheets mehrfach auswählen
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle4")).Select 'Was ist mit Tabelle3 ?

With Worksheets("CopyBefehl")
For lngZ = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(lngZ, 2)).Copy Range(.Cells(lngZ, 3))
Next
End With
End Sub

Der Code sucht im Blatt "CopyBefehl" in Spalte B ab Zeile 4 bis nach unten die zu kopierenden Bereiche und kopiert sie in den in Spalte C angegebenen Zellbereich.
In Spalte 4 genügt dabei die Angabe der ersten Zelladresse des Zeilebereiches (also z.B. nur B6 anstatt B6:B7).

oneofus79
28.04.2009, 17:26
Hallo NoNet,

vielen Dank für die prompte Antwort.

Dein Code wählt zwar alle drei Tabellen aus (Tabelle3 wurde von mir extra ausgelassen ;-) ) jedoch kopiert er am Ende nur die Daten in Tabelle1 entsprechend der Vorgaben im "CopyBefehl".

Kann man den Code noch anpassen, dass er bei allen Sheets die Vorgaben anwendet?

Desweiteren sind die Vorgaben in Spalte B und C
Spalte B Spalte C
C3:C4 B3:B4
C6:C8 B6:B8
sehr wichtig. Häufig müssen ganz bestimmte Zeilen kopiert werden.
Wird das dann auch im Code berücksichtigt?

Ich habe die Datei nochmal um deinen Code ergänzt um meinen
Originalcode hinten angehängt.

VG,
Emos

NoNet
28.04.2009, 17:45
Hallo Emos,

in der Tat ist bei einer Mehrfachselektion das ungeliebte "Select" nötig, damit Excel kapiert, dass sich der Kopiervorgang auf alle markierten Blätter beziehen soll - das hatte ich zunächst übersehen.

Hier der angepasste Code :
Sub ZellenCopy()
Dim WbDatei1 As Workbook
Dim lngZ As Long 'Zeilenindex

Set WbDatei1 = ThisWorkbook

'Input Sheets mehrfach auswählen
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle4")).Select

With Worksheets("CopyBefehl")
For lngZ = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(lngZ, 2)).Copy
Range(.Cells(lngZ, 3)).Select
ActiveSheet.Paste
Next
End With

Range("A1").Select
Application.CutCopyMode = False
End Sub
Wenn Du in Spalte B z.B. $10:$10 und in der entsprechenden Spalte C $A$20 eingibst, dann wird die komplette Zeile 10 in die Zeile 20 kopiert - das ist im Makro bereits berücksichtigt !

oneofus79
29.04.2009, 09:54
Hallo NoNet,

das ist total genial! Vielen Dank!

Vielleicht kannst Du mir noch zwei Fragen beantworten damit auch mein Chef hier endlich mal meine Begeisterung teilen kann. :rolleyes:

Ich würde gerne statt dem normalen Paste den pastevalue einfügen.
Irgendwie komme ich aber nicht auf den richtigen Befehl :-( (siehe unten)

Desweiteren sind meine Copy Aktionen leider nicht immer besetzt
(Danke Excel-Link Einspeisung).

1. Aktion C3:C4 B3:B4
2. Aktion C6:C7 B6:B7
3. Aktion
4. Aktion C8:C8 B8:B8


Gibt es eine Möglichkeit die Range auf sagen wir mal die
Zeilen 4-8 zu setzen anstatt End.(xlUp) zu verwenden
und eventuelle Leerfelder im Code zu ignorieren?


For lngZ = 4 To .Cells(Rows.Count, 2).End(xlUp).Row

P.S.: Ich glaube am Ende dieses Threats ist ein Kastenbier fällig...

VG,
Emos


Sub ZellenCopy()
Dim WbDatei1 As Workbook
Dim lngZ As Long 'Zeilenindex

Set WbDatei1 = ThisWorkbook

'Input Sheets mehrfach auswählen
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle4")).Select

With Worksheets("CopyBefehl")
For lngZ = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(lngZ, 2)).Copy
Range(.Cells(lngZ, 3)).Select
' ActiveSheet.Paste 'Vorzugsweise sollen jetzt nur noch Werte eingefügt werden
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'funzt nicht :-(
Next

End With

Range("A1").Select
Application.CutCopyMode = False
End Sub