Dateipfad einer Datei in Zelle einer anderen Datei hinterlegen.

Private Sub CommandButton1_Click() Dim letzte_zeile As Long, Zeile As Long, Spalte As Long Spalte = 7 '1=Spalte A, 2=Spalte B etc. letzte_zeile = Cells(Rows.Count, Spalte).End(xlUp).Row 'Letzte Zeile der Spalte ermitteln For Zeile = 3 To letzte_zeile 'Beginnt ab Zeile 3 Cells(Zeile, Spalte).Value = TextBox1 & Cells(Zeile, _ Spalte).Text & "" 'Schreibt vor und nach den Zelleninhalt Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton1_Click() Dim letzte_zeile As Long, Zeile As Long, Spalte As Long, strPfad As String Spalte = 7 '1=Spalte A, 2=Spalte B etc. letzte_zeile = Cells(Rows.Count, Spalte).End(xlUp).Row 'Letzte Zeile der Spalte ermitteln Application.FileDialog(msoFileDialogFolderPicker).Show strPfad = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) For Zeile = 3 To letzte_zeile 'Beginnt ab Zeile 3 With Cells(Zeile, Spalte).AddComment .Text strPfad End With Next End Sub

Private Sub CommandButton1_Click() Dim letzte_zeile As Long, Zeile As Long, Spalte As Long Dim strPfad As String, rngZelle As Range Spalte = 7 '1=Spalte A, 2=Spalte B etc. strPfad = "T:\Test\Datei_B.xlsx" letzte_zeile = Cells(Rows.Count, Spalte).End(xlUp).Row 'Letzte Zeile der Spalte ermitteln For Zeile = 3 To letzte_zeile 'Beginnt ab Zeile 3 With Cells(Zeile, Spalte) .Value = TextBox1 & .Text & "" 'Schreibt vor und nach den Zelleninhalt 'Kommentar einfügen/Text ändern If .Comment Is Nothing Then .AddComment Text:=strPfad Else .Comment.Text Text:=strPfad End If With .Comment 'Kommentarfeld formatieren With .Shape .Height = 20 .Width = 150 .TextFrame.Characters.Font.Size = 10 End With End With End With Next End Sub

Private Sub CommandButton1_Click() Dim letzte_zeile As Long, Zeile As Long, Spalte As Long, strPfad As String Spalte = 7 '1=Spalte A, 2=Spalte B etc. letzte_zeile = Cells(Rows.Count, Spalte).End(xlUp).Row 'Letzte Zeile der Spalte ermitteln Application.FileDialog(msoFileDialogFolderPicker).Show strPfad = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) For Zeile = 3 To letzte_zeile 'Beginnt ab Zeile 3 If .Comment Is Nothing Then .AddComment Text:=strPfad Else .Comment.Text Text:=strPfad End If With .Comment 'Kommentarfeld formatieren With .Shape .Height = 20 .Width = 150 .TextFrame.Characters.Font.Size = 10 End With End With Next End Sub

Private Sub CommandButton1_Click() Dim letzte_zeile As Long, Zeile As Long, Spalte As Long, strPfad As String Spalte = selection.cells(1).column '1=Spalte A, 2=Spalte B etc. letzte_zeile = Cells(Rows.Count, Spalte).End(xlUp).Row 'Letzte Zeile der Spalte ermitteln Application.FileDialog(msoFileDialogFolderPicker).Show strPfad = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) For Zeile = 3 To letzte_zeile 'Beginnt ab Zeile 3 If .Comment Is Nothing Then .AddComment Text:=strPfad Else .Comment.Text Text:=strPfad End If With .Comment 'Kommentarfeld formatieren With .Shape .Height = 20 .Width = 150 .TextFrame.Characters.Font.Size = 10 End With End With Next End Sub

Private Sub CommandButton1_Click() Dim Zeile As Long, Spalte As Long Dim strPfad As String, rngZelle As Range Dim varDatei_B As Variant, wkb_B As Workbook, wks_B As Worksheet Dim wkb_A As Workbook, wks_A As Worksheet, rngZiel As Range On Error GoTo Fehler 'Spalte auswählen, in die Werte aus Datei B eingetragen werden sollen Set rngZelle = Application.InputBox("Daten in dieser Spalte eintragen?" & vbLf _ & "(ggf. Zelle in anderer Spalte wählen)", _ Title:="Daten in Datei B holen und in dieser Spalte eintragen", _ Default:=ActiveCell.Address, Type:=8) Spalte = rngZelle.Column Zeile = 3 'Zeile ab der eingetragen werden soll With Application.FileDialog(msoFileDialogOpen) .Title = "Bitte Datei mit den zu übertagenden Daten auswählen" .AllowMultiSelect = False If .Show = -1 Then varDatei_B = .SelectedItems(1) Else 'Dateiauswahl wurde abgebrochen GoTo Fehler End If End With Set wkb_A = ActiveWorkbook Set wks_A = ActiveSheet 'gewählte Datei schreibgeschützt öffnen Set wkb_B = Application.Workbooks.Open(Filename:=varDatei_B, ReadOnly:=True) Do 'Zielzelle in Datei A setzen Set rngZiel = wks_A.Cells(Zeile, Spalte) Set rngZelle = Application.InputBox( _ "Bitte Zelle auswählen mit zu übertragenden Daten", _ "Daten aus Datei B in Zelle " & rngZiel.Address(False, False, xlA1) _ & " eintragen", Type:=8) On Error GoTo Fehler 'Auswahl wurde abgebrochen Set wks_B = ActiveSheet With rngZiel ' .Value = wks_B.Range(rngZelle.Address).Value .Value = rngZelle.Value If .Comment Is Nothing Then .AddComment Text:=varDatei_B Else .Comment.Text Text:=varDatei_B End If With .Comment With .Shape .Height = 30 .Width = 150 .TextFrame.Characters.Font.Size = 10 End With End With End With Zeile = Zeile + 1 If Zeile = 18 Then MsgBox "Es wurden Zellen bis Zeile 17 schon ausgefüllt.", _ vbInformation + vbOKOnly, "Daten aus Datei B holen" Exit Do End If Loop wkb_B.Close savechanges:=False Set wkb_B = Nothing Fehler: With Err Select Case .Number Case 0 'alles ist OK Case 424 'Objekt erforderlich 'Die Auswahl von Zellen in Datei B wurde abgebrochen If Not wkb_B Is Nothing Then wkb_B.Close savechanges:=False Case Else MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _ vbOKOnly, "Fehler-Behandlung" End Select End With End Sub

Hallo Franz,
entschuldige bitte die zuvor erwähnten Kommentare von mir ignorieren.
Ich bin an einem Projekt dran daher ändert sich das Vorhaben immer wieder.
Also der erste Code erfüllt nun seine Funktion in seinem Anwendungsgebiet.
Jetzt bräuchte ich ein Lösung für folgendes Problem. Entschuldige schon mal für das Hin und Her.
Ich habe eine Datei A, in der von G3 bis G17 (Zeilen) und von G3 bis L3 (Spalten) Werte drine stehe.
Diese Werte sind verschiedenen Dateien zuzuordnen. Das heißt G3 bis G17 hat Werte aus einer Datei B. H3 bis H17 hat Werte aus einer Datei C usw.
Da die anderen Dateien aber alle gleich aufgebaut sind möchte ich nun bestimmte Werte aus Datei B in die Spalte G3 bis G17 in Datei A übertragen mit der Angabe des Dateipfades als Kommentar wie du es auch im ersten Code schon sehr schön gemacht hast.
Genau so dann auch Werte aus Datei C in die Spalte H3 bis H17 in Datei A übertragen. Das soll bis zur Spalte L3 bis L17 gehen.
Jetzt dazu woher die Daten kommen.
- Durch Klick auf den Button soll sich der Explorer öffnen
- Ich navigiere zur entsprechenden Datei (X) und wähle diese aus
- Ich klicke auf Okay im Explorer und Datei A soll alle Werte in G3 bis G17 eingefügt bekommen die in der andere Datei enthalten sind
Um zu wissen in welchen Zellen die Werte in den anderen Dateien enthalten sind, dazu folgende Info :
Alle Dateien die ich auswählen werde um die Werte in Datei A zu übertragen, haben feste Zellen in den anderen Dateien. Es geht um insgesamt 15 Parameter.
Übertragen werden sollen genau in der Reihenfolge :
D17 aus gewählter Datei nach G3 Datei A übernehmen und Dateipfad als Kommentar
D25 aus gewählter Datei nach G4 Datei A übernehmen und Dateipfad als Kommentar
D18 aus gewählter Datei nach G5 Datei A übernehmen und Dateipfad als Kommentar
D13 aus gewählter Datei nach G6 Datei A übernehmen und Dateipfad als Kommentar
D16 aus gewählter Datei nach G7 Datei A übernehmen und Dateipfad als Kommentar
D14 aus gewählter Datei nach G8 Datei A übernehmen und Dateipfad als Kommentar
D21 usw.
D22 usw.
D38 usw.
D20 usw.
D36 usw.
D34 usw.
D31 usw.
D32 usw.
D33 usw. G17
Diese Zellen sind in allen Dateien gleich daher kann man dies fest im Code so definieren.
Für jede Spalte soll es einen Button geben mit dem gleichen Code natürlich, um somit die Funktion für jede Spalte von G3 bis L3 zu erfüllen.
Ich danke dir schon mal im Voraus für die Mühe und die genommene Zeit.
Viele Grüße
Erik

Hallo Erik,
hier die angepassten Makros um
A) Aus vorgegebenen Zellen in Datei B die Werte in die gewählte Spalte in Datei A zu übertragen
B) Den Dateinamen der gewählten Datei B als Kommentar bei bestimmten Zellen in Datei einzufügen.
LG
Franz

Private Sub CommandButton1_Click()
'Werte aus 15 vorgegebenen Zellen in Datei B ab Zeile 3 in die gewählte _
Spalte eintragen und Pfad als Kommentar.
Dim Zeile As Long, Spalte As Long
Dim strPfad As String, rngZelle As Range
Dim varDatei_B As Variant, wkb_B As Workbook, wks_B As Worksheet
Dim wkb_A As Workbook, wks_A As Worksheet, rngZiel As Range
Dim arrQuelle() As String, iItem As Integer
'Array für Zellen mit Quelldaten anlegen
ReDim arrQuelle(1 To 15)
'Adressen der Quellzellen in Array einlesen
iItem = 1: arrQuelle(iItem) = "D17"
iItem = iItem + 1: arrQuelle(iItem) = "D25"
iItem = iItem + 1: arrQuelle(iItem) = "D18"
iItem = iItem + 1: arrQuelle(iItem) = "D13"
iItem = iItem + 1: arrQuelle(iItem) = "D16"
iItem = iItem + 1: arrQuelle(iItem) = "D14"
iItem = iItem + 1: arrQuelle(iItem) = "D21"
iItem = iItem + 1: arrQuelle(iItem) = "D22"
iItem = iItem + 1: arrQuelle(iItem) = "D38"
iItem = iItem + 1: arrQuelle(iItem) = "D20"
iItem = iItem + 1: arrQuelle(iItem) = "D36"
iItem = iItem + 1: arrQuelle(iItem) = "D34"
iItem = iItem + 1: arrQuelle(iItem) = "D31"
iItem = iItem + 1: arrQuelle(iItem) = "D32"
iItem = iItem + 1: arrQuelle(iItem) = "D33"
On Error GoTo Fehler
'Spalte auswählen, in die Werte aus Datei B eingetragen werden sollen
Set rngZelle = Application.InputBox("Daten in dieser Spalte eintragen?" & vbLf _
& "(ggf. Zelle in anderer Spalte wählen)", _
Title:="Daten in Datei B holen und in dieser Spalte eintragen", _
Default:=ActiveCell.Address, Type:=8)
Spalte = rngZelle.Column
Zeile = 3 'Zeile ab der in A eingetragen werden soll
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Datei mit den zu übertagenden Daten auswählen"
.AllowMultiSelect = False
If .Show = -1 Then
varDatei_B = .SelectedItems(1)
Else
'Dateiauswahl wurde abgebrochen
GoTo Fehler
End If
End With
Set wkb_A = ActiveWorkbook
Set wks_A = ActiveSheet
'gewählte Datei schreibgeschützt öffnen
Set wkb_B = Application.Workbooks.Open(Filename:=varDatei_B, ReadOnly:=True)
Set wks_B = wkb_B.Sheets(1)
Application.ScreenUpdating = False
For iItem = 1 To UBound(arrQuelle)
'Zielzelle in Datei A setzen
Set rngZiel = wks_A.Cells(Zeile, Spalte)
With rngZiel
.Value = wks_B.Range(arrQuelle(iItem)).Value
If .Comment Is Nothing Then
.AddComment Text:=varDatei_B
Else
.Comment.Text Text:=varDatei_B
End If
With .Comment
With .Shape
.Height = 30
.Width = 150
.TextFrame.Characters.Font.Size = 10
End With
End With
End With
Zeile = Zeile + 1
Next
Application.ScreenUpdating = False
wkb_B.Close savechanges:=False
Set wkb_B = Nothing
Application.ScreenUpdating = True
Fehler:
With Err
Select Case .Number
Case 0 'alles ist OK
Case 424 'Objekt erforderlich
'Die Auswahl von Zellen in Datei B wurde abgebrochen
If Not wkb_B Is Nothing Then wkb_B.Close savechanges:=False
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler-Behandlung"
End Select
End With
End Sub
Private Sub CommandButton3_Click()
'Pfad der ausgewählten Datei B in Zellbereich G3:17 und H3:L3 des aktiven Blattes _
als Kommentar ergänzen - keine Werte Eintragen.
Dim strPfad As String
Dim varDatei_B As Variant, wkb_B As Workbook
Dim wks_A As Worksheet, rngZiel As Range
On Error GoTo Fehler
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Datei mit den zu übertagenden Daten auswählen"
.AllowMultiSelect = False
If .Show = -1 Then
varDatei_B = .SelectedItems(1)
Else
'Dateiauswahl wurde abgebrochen
GoTo Fehler
End If
End With
Set wks_A = ActiveSheet
Application.ScreenUpdating = False
With wks_A
For Each rngZiel In Application.Union(.Range("G3:G17"), .Range("H3:L3")).Cells
With rngZiel
If .Comment Is Nothing Then
.AddComment Text:=varDatei_B
Else
.Comment.Text Text:=varDatei_B
End If
With .Comment
With .Shape
.Height = 30
.Width = 150
.TextFrame.Characters.Font.Size = 10
End With
End With
End With
Next
End With
Application.ScreenUpdating = True
Fehler:
With Err
Select Case .Number
Case 0 'alles ist OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler-Behandlung"
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Dateipfad einer Datei in Zelle einer anderen Datei hinterlegen.

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dateipfad einer Datei in Zelle einer anderen Datei hinterlegen.

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread