Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1828to1832
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
Inhaltsverzeichnis

Felder aus anderen Dateien übernehmen

Felder aus anderen Dateien übernehmen
27.04.2021 10:39:37
Snaik
Hallo liebe Experten :)
Ich habe 2 fast identische Excel-Dateien mit mehreren Tabellenblättern, eine Datei davon dient als Vorlage (=Vorlage) und aus der anderen Datei (=Kalkulation) sollen die Werte in die Vorlage übernommen werden - jedoch soll eine neue Datei angelegt werden, damit die Vorlage noch als Vorlage weiter dient. Beide Dateien enthalten diverse Datenblätter, ich benötige jedoch nur bestimmte Werte aus sagen wir "Datenblatt1".
Sagen wir einfach als Beispiel mal
Zelle A3: Kunde
Zelle B5: Artikelnummer

aus
Datenblatt1
in
neue Datei, die "Vorlage" verwendet
in
Datenblatt1
Die Zellen in den Dateien Kalkulation und Vorlage sind identisch - bis auf die Werte, neue Datei soll gemäß Vorlage erstellt werden und die Werte aus Kalkulation übernehmen.
Da ich dies aber automatisiert ablaufen lassen möchte weil es sehr viele Dateien sind und die Werte immer unterschiedlich sind, bin ich nun auf die VBA-Programmierung gekommen.
Ist es realisierbar, dass ich die oben genannten Zellen in "Kalkulation" aus dem "Datenblatt1" in eine neue Datei schreiben lasse, die die "Vorlage" verwendet?
Vielen Dank schon mal für eure Hilfe, ich hoffe das war einigermaßen verständlich.
Ich freue mich auf die Antworten :)
Evtl. wäre ein Grundgerüst toll, welches mir bei meinen ersten Schritten in VBA helfen könnte :).
Liebe Grüße.

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: und warum lädst Du kein Grundgerüst hoch? owT
27.04.2021 10:47:44
JoWE
AW: und warum lädst Du kein Grundgerüst hoch? owT
27.04.2021 11:00:56
Snaik
Weil ich leider keine VBA Kenntnisse habe, ich habe gehofft, ihr könnt mir da etwas weiter helfen eine Lösung für mein Problem zu finden.
AW: Gemeint waren jetzt aber Arbeitsmappen
27.04.2021 11:08:13
JoWE
AW: Gemeint waren jetzt aber Arbeitsmappen
27.04.2021 11:43:39
Snaik
Die Datei war zu groß, ich habe mal die Datei entsprechend aufgeräumt um sensible Daten zu schützen.
Hier sieht man zum Beispiel das Feld Kunde (A3) und Produktnummer (B5), diese sollen übernommen werden.
AW: die Anlage ist wo?
27.04.2021 13:03:21
JoWE
AW: die Anlage ist jetzt da; Lösung noch gesucht
27.04.2021 13:56:31
JoWE
ich komme mit der Fragestellung nicht wirklich klar.
Es hat bestimmt jemand ein zündende Idee?
Anlage da, aber Mucks
27.04.2021 19:35:27
Yal
Hallo Snaik,
wenn Du Hilfe bekommen möchtest, solltest Du eine Aussage-fähige Datei liefern. Lasse ein paar Pseudo-Daten drin und zeichne genau, was aktuelle Zustand und was Ziel ist. Gedanken lesen kann hier keiner.
VG
Yal
Felder aus anderen Dateien übernehmen
29.04.2021 10:06:40
fcs
Hallo Snaik,
ich bin in meinem Fundus fündig geworden.
Ich hab die Datei ein wenig angepasst an deine Fragestellung.
https://www.herber.de/bbs/user/145847.xlsm
Das Übertragungsmakro öffnet jeweils Quelldatei und Vorlage und überträgt die Inhalte der Zellen aus der Quelle in die Vorlage.
Beachte bitte die Hinweise auf Blatt "Infos".
LG
Franz
Anzeige
AW: Vielen Dank! #gelöstDurchFranz
29.04.2021 10:30:57
Snaik
Wow, ich danke dir vielmals! Das ist ja mehr als ausführlich!
Noch eine Frage (Passwortschutz)
29.04.2021 13:26:50
Snaik
Hallo noch mal,
und zwar kommt bei mir ein Fehler (Laufzeitfehler '1004') dass die jeweilige Zelle passwortgeschützt sei.
Ich habe versucht, bevor der Wert in die Vorlage eingetragen wird den Passwortschutz mit
ThisWorkbook.Worksheets("NK_Fertigungskalkulation").Protect "beispielpasswort"
zu deaktivieren und danach wieder zu aktivieren. Allerdings funktioniert das nicht und es kommt (Laufzeitfehler '9', Index außerhalb des gültigen Bereichs).
Die Aufhebung wurde vor
wkbVorlage.Worksheets(arrZellen(zeiZelle, 7)).Cells(arrZellen(zeiZelle, 8), arrZellen(zeiZelle, 9)).Value = varWert
gesetzt.
Anzeige
AW: Noch eine Frage (Passwortschutz)
29.04.2021 17:42:17
Yal
Hallo Snaik,

ThisWorkbook.Worksheets("NK_Fertigungskalkulation").Unprotect "beispielpasswort"
'... Doing
ThisWorkbook.Worksheets("NK_Fertigungskalkulation").Protect "beispielpasswort"
Zu "ausserhalb des gültigen bereichs"
wkbVorlage.Worksheets(arrZellen(zeiZelle, 7)).Cells(arrZellen(zeiZelle, 8), arrZellen(zeiZelle, 9)).Value = varWert
Da müsstest Du prüfen, dass
arrZellen(zeiZelle, 7) ein gültigen Worksheet-Name (in wbkVorlage existierend),
arrZellen(zeiZelle, 8) ein gültigen Zeilennummer (>= 0)
arrZellen(zeiZelle, 9) en gültigen Spaltennummer (dito)
darstellen.
Und da arrZellen wohl ein Array ist, dass UBound(arrZellen) mindestens 9 ist.
VG
Yal
Anzeige
AW: Noch eine Frage (Passwortschutz)
30.04.2021 12:07:40
fcs
Hallo Snaik,
ich hab das Makro prcDatenUebertragen angepasst, sodass nach dem Öffnen der Vorlage der Blattschutz für alle Blätter in die Daten übertragen werden aufgehoben wird.
Vor dem Speichern/Schliessen wird der Blattschutz wieder aktiviert.
Im Code musst du das Kennwort für den Blattschutz anpassen!
LG
Franz

Sub prcDatenUebertragen()
Dim wkbQuelle As Workbook
Dim wkbVorlage As Workbook
Dim arrZellen
Dim varWert
Dim strPfadNeu As String, strNameNeu As String
Dim strVorlage As String
Dim colSheets As New Collection, iCol As Integer
Dim zeiZelle As Long
Dim lngZei As Long
Const strPW As String = "beispielpasswort" 'Kennwort für Blattschutz     'ggf. anpassen
On Error GoTo Fehler
With tabSteuerung
'Werte einlesen und Variablen zuweisen
'Pfad+Name der Vorlage-Datei
strVorlage = .Cells(mZei_T - 1, 12)
'Verzeichnis in dem die neuu erstellten Dateien gespeichert werden sollen
strPfadNeu = .Cells(mZei_T - 1, 13)
'letzte Zeile im Zellbereich mit den Zellzuweisungen
zeiZelle = .Cells(.Rows.Count, 1).End(xlUp).Row
'Zellbereich mit den Zellzuweisungen in ein Datenarray einlesen - beschleunigt die Makro-Ausführung
arrZellen = .Range(.Cells(mZei_T + 1, 1), .Cells(zeiZelle, 10)).Value2
'Namen der Blätter in der Vorlage, in die Werte eingetragen werden sollen, in einer Collection sammeln
For zeiZelle = LBound(arrZellen, 1) To UBound(arrZellen, 1)
colSheets.Add arrZellen(zeiZelle, 7), Key:=arrZellen(zeiZelle, 7)
Next
'ausgewählte Dateien abarbeiten
For lngZei = mZei_T + 1 To .Cells(.Rows.Count, 12).End(xlUp).Row
'Quelle mit Daten schreibgeschützt öffnen
Application.EnableEvents = False
Set wkbQuelle = Application.Workbooks.Open(Filename:=.Cells(lngZei, 12).Text, ReadOnly:=True)
Application.EnableEvents = True
'Berechnung des Dateinamens der neuen Datei
With wkbQuelle.Worksheets("NK_Fertigungskalkulation") 'Blattname ggff. anpassen
strNameNeu = "KdNr " & .Cells(5, 4).Text & " - ProdNr " & .Cells(5, 2).Text & ".xlsx"
End With
'Vorlage scheibgeschütz öffnen
Set wkbVorlage = Application.Workbooks.Open(Filename:=strVorlage, ReadOnly:=True)
'Vorlage unter neuem Namen speichern und schliessen
wkbVorlage.SaveAs Filename:=strPfadNeu & strNameNeu, FileFormat:=51
'Schutz der Blätter aufheben
With wkbVorlage
For iCol = 1 To colSheets.Count
.Worksheets(colSheets(iCol)).Unprotect Password:=strPW
Next
End With
'Zellzuweisungen abarbeiten
For zeiZelle = LBound(arrZellen, 1) To UBound(arrZellen, 1)
'Wert in Zelle in der Quelle in Variable
varWert = wkbQuelle.Worksheets(arrZellen(zeiZelle, 1)).Cells(arrZellen(zeiZelle, 2), arrZellen(zeiZelle, 3)).Value
'Prüfen, ob Zelle einen Fehlerwert enthält
If IsError(varWert) Then
'angezeigten Text der Zelle in Variable einlesen
varWert = wkbQuelle.Worksheets(arrZellen(zeiZelle, 1)).Cells(arrZellen(zeiZelle, 2), arrZellen(zeiZelle, 3)).Text
'Prüfen, ob Zelle leer ist
ElseIf IsEmpty(varWert) Then
varWert = ""
End If
'Wert in Vorlage eintragen
wkbVorlage.Worksheets(arrZellen(zeiZelle, 7)).Cells(arrZellen(zeiZelle, 8), arrZellen(zeiZelle, 9)).Value = varWert
Next zeiZelle
'Schutz der Blätter wieder aktivieren
With wkbVorlage
For iCol = 1 To colSheets.Count
.Worksheets(colSheets(iCol)).Protect Password:=strPW
Next
End With
'Neue Datei speichern und schliessen
wkbVorlage.Close savechanges:=True
'neuen Namen in Blatt "Steuerung" eintragen
.Cells(lngZei, 13).Value = strNameNeu
'Quelldatei schliessen
wkbQuelle.Close savechanges:=False
Next lngZei
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case 457
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbOKOnly, "Fehler - Makro: prcDatenUebertragen"
End Select
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige