PDA

Vollständige Version anzeigen : Zellwerte kopieren und übertragen


chrissi641
22.02.2008, 15:06
Hallo Zusammen,

ich stehe vor folgendem Problem:

Ich habe ein Formular (Erfassung.xls) erstellt, welches bestimmte Daten erfasst.
Zudem habe ich ein Formular, welches alle bisherigen Vorgänge auflistet.

Ich möchte gerne die rot markierten Zelleinträge aus Erfassung.xls in die entsprechenden Zellen in Übersicht.xls kopieren.

Hierbei soll Übersicht.xls fortlaufend geführt werden, so dass beim kopieren der Zellwerte zunächste die nächste freie Zeile in Übersicht.xls gesucht werden muss.

Ich hoffe, ich habe mich halbwegs verständlich ausgedrückt, und ihr könnt mir ein Steuerelement-Makro erstellen, da ich was VBA angeht ein ziemlicher Anfänger bin.

Beste Grüße,
Christoph

Sebastian Schulz
24.02.2008, 08:42
Hallo Chrisoph,

habe dir mal ein kleines Beispiel geschrieben. Vll. kommst du damit ja klar.

Sub Datenuebertragen()

'Ausschalten der Bildschirmakivität
Application.ScreenUpdating = False

'Deklaration der Variablen
Dim wkbOutput As Workbook
Dim wksOutput As Worksheet

Dim wkbInput As Workbook
Dim wksInput As Worksheet

Dim lrow As Integer
Dim wkboutputpath As String

'Zuweisen von Werten
'wkboutputpath müsstest du wenn erforderlich noch deinen Bedürfnissen anpassen
wkboutputpath = ThisWorkbook.Path
Set wkbInput = ActiveWorkbook
Set wksInput = wkbInput.Sheets("Tabelle1")
Set wkbOutput = Application.Workbooks.Open(wkboutputpath & "\Uebersicht.xls")
Set wksOutput = wkbOutput.Worksheets("Tabelle1")


'Letzte benutze Zelle in Zieltabelle ermitteln
lrow = wksOutput.Range("B65536").End(xlUp).Row

'Daten übertragen
With wksOutput
'Reklamationsnummer
.Cells(lrow + 1, 2).Value = wksInput.Range("BX3").Value
'Datum
.Cells(lrow + 1, 3).Value = wksInput.Range("M13").Value
'Kunde
.Cells(lrow + 1, 4).Value = wksInput.Range("BI7").Value
'Artikel
.Cells(lrow + 1, 5).Value = wksInput.Range("BJ19").Value
'Farbe
.Cells(lrow + 1, 6).Value = wksInput.Range("BI21").Value
'Mangel
.Cells(lrow + 1, 7).Value = wksInput.Range("B30").Value
'Größe
.Cells(lrow + 1, 8).Value = wksInput.Range("CE21").Value
End With

'Daten speichern und Datei schließenn
ActiveWorkbook.Save
ActiveWorkbook.Close

'Schaltet die Bildschirmaktivität wieder ein
Application.ScreenUpdating = True

'Meldung ausgeben
MsgBox "Daten wurden erfolgreich übertragen"
End Sub

chrissi641
01.03.2008, 10:26
Hallo Sebastian,

leider funktioniert das Makro bis dato noch nicht.
Irgendwie passiert gar nichts.

Muss ich vorher noch irgend etwas anderes tun?

Beste Grüße,

Christoph

chrissi641
01.03.2008, 10:31
Kommando zurück.

Funktioniert fast zu 100%.

Der Rest ist Optik ;-)

1000Dank nochmal.