Daten auf anderes Blatt verschieben

Question

Hallo wer kann mir helfen,

mein problem ist eine Datensammlung zu erzeugen, um ein Auflistung von nur bestimmten Daten zu erhalten!
Also:
Ich fülle ein Datenblatt aus (Artikelnr.,Name, Preis, usw.)
und möchte nur bestimmte Daten (Zellen) auf ein anderes Blatt in eine Tabelle einfügen.
Nun fülle ich das gleiche Datenblatt erneut aus(Artikelnr.,Name, Preis, usw.) und möchte wieder die gleichen Zellen in die Tabelle (in die nächste freie Zeile) einfügen.
usw usw
Viel Spass bei meiner Lösung und ich bedanke mich schon mal.
Gruß
Ulle

Answer 1

Hallo Fedjo,
so weit so gut.
Wie kann ich jetzt verhindern das andere Nutzer der Tabelle, die ungeschützten Bereiche (Text,Überschriften usw.)verändern.
Vieleicht bin ich auch nur übervorsichtig?
Die schreibgeschützte Orginaltabelle kann ja niemand ändern, trotzdem würde mich das interesieren wie das geht.
Gruß
Ulle

Answer 2

Hallo Ulle,
Code "Formeln schützen" löschen.
Blattschutz aufheben.
Alle Zellen (D10) die nicht geschützt werden sollen markieren, Zellen formatieren, Schutz gesperrt Häkchen entfernen, OK.
Blatt schützen.

Gruß
fedjo

http://www.file-upload.net/download-1412045/Mappe1.xls.html

Answer 3

Hallo Fedjo,
manchmal ist die Lösung so leicht.
Ich hatte schon das Kontrollkästchen aufgegeben, werde es aber wieder einbauen.
Es gefällt mir einfach.
Mit deinen Makro habe ich jetzt einen Tag gearbeitet, es hat eine weile gedauert bis ich die Arbeitsweise erkannt habe.
Ich muß es noch etwas umbauen, bis ich die Datentabelle nutzen kann. Das bekomme ich hoffendlich alleine hin, Daß Ergebnis werde ich dir zukommen lassen.
Denn ich glaube es interesiert dich was mit Deiner hilfe so entsteht.
Noch mal schönen Dank für Deine Hilfe!!
Gruß
Ulle

Answer 4

Hallo Fedjo oder alle Anderen die mir helfen können.
Das unten eingegebene Makro funktioniert einwandfrei!!
Ich möchte nicht "Bt1" sondern vom "aktiven Blatt" kopieren und
die Datensammlung liegt in einer anderen Mappe(Stammdaten).
Mein Wissen reicht dafür noch nicht aus, aber eine Lösung gibt es ja bestimmt für mein Problem.
Danke im vorraus.
Gruß Ulle



Sub SpeichernGIVDaten()

Application.ScreenUpdating = False

Worksheets("Bt1").Range("B57:J58").Copy 'Angebot
Sheets("DATENSAMMLUNG").Select
Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 3).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column - 2) = Worksheets("Bt1").Range("C6").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column - 1) = Worksheets("Bt1").Range("C5").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 12) = Worksheets("Bt1").Range("E60").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 2) = Worksheets("Bt1").Range("E10").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1) = Worksheets("Bt1").Range("C10").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = Worksheets("Bt1").Range("G5").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = Worksheets("Bt1").Range("C45").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = Worksheets("Bt1").Range("C42").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = Worksheets("Bt1").Range("C43").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = Worksheets("Bt1").Range("C44").Value

Worksheets("Bt1").Range("B30:B40").Copy
Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("C65536").End(xlUp).Select
Sheets("Bt1").Select
Application.CutCopyMode = False

End Sub

Answer 5

Hallo Ulle,
du kannst die Arbeitsmappe mit dem Code gleich am Anfag öffnen lassen (Pfad ändern)
Workbooks.Open FileName:="C:\Stammdaten.xls" 'Pfad ändern

Arbeitsmappe schliesen am Ende des Codes
Windows("Stammdaten.xls").Close SaveChanges:=True (False)


Option Explicit
Sub SpeichernGIVDaten()
Application.ScreenUpdating = False
ActiveSheet.Range("B57:J58").Copy 'Angebot

Windows("Stammdaten.xls").Activate
Sheets("Datensammlung").Select
Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 3).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column - 2) = ActiveSheet.Range("C6").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column - 1) = ActiveSheet.Range("C5").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 12) = ActiveSheet.Range("E60").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 2) = ActiveSheet.Range("E10").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1) = ActiveSheet.Range("C10").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("G5").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C45").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C42").Value

Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C43").Value

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C44").Value

ActiveSheet.Range("B30:B40").Copy
Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("C65536").End(xlUp).Select
Application.CutCopyMode = False
Windows("Deine Mappe.xls").Activate 'Arbeitsmappe ändern
Sheets("Tabelle1").Select
End Sub

Answer 6

Hallo Fedjo,
der erst Schritt funktioniert.


Option Explicit
Sub SpeichernGIVDaten()
Application.ScreenUpdating = False
ActiveSheet.Range("B57:J58").Copy 'Angebot

Windows("Stammdaten.xls").Activate
Sheets("Datensammlung").Select
Range("c65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column + 3).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("C65536").End(xlUp).Select
Cells(ActiveCell.Row + 3, ActiveCell.Column - 2) = ActiveSheet.Range("C6").Value

Im zweiten Schritt ActiveSheet meine Datensammlung und nicht mein Kalkulationsblatt(Einzelteil)!!!!!! Also findet das Makro die zu kopierenden Zellen nicht mehr.
Die Stammdaten sind immer geöffnet, ich muss sie nicht mit dem Makro öffnen.
Gruß
Ulle

Answer 7

Hallo Ulle,
der Code sollte funktionieren, wenn du deine geöffnete Arbeitsmappen einträgst.

Gruß
fedjo

Windows("Dein Name Arbeitsmappe.xls").Activate

Answer 8

Hallo Fedjo,
das Makro läuft ohne Fehlermeldung durch.
Ich habe alles eingetragen!!
Das Makro trägt nur die ersten Daten(ActiveSheet.Range("B57:J58").Copy 'Angebot) auf der Datensammlung ein,mehr nicht.
Fülle ich die Zellen C5;C6;E60 in der "Datensammlung" aus werden diese Daten in der Datensmmlung eingetragen, wie das Makro es sagt. Was es aber nicht sol!
Die Daten vom "Aktiven Blatt" nicht?????
Gruss
Ulle

Answer 9

Hallo Ulle,
stimmt das Makro kann so nicht mehr funktionieren.
Es braucht einen Bezug (Namen) zur Arbeismappe und der Tablle.

Gruß
fedjo

Answer 10

Hallo Fedjo,
dieses Problem habe ich gelößt.
Ich habe mit dem Makro die Daten auf dem Orginaldatenblatt
zusammengefast und als Block in die Datensammlung geschoben.
Das Makro läuft viel schneller!!
Nur eins geht nicht, mit Makro Daten aus gesperrten Zellen kopieren. Da bleibt das Makro stehen.
Gruß
Ulle