Datei öffnen, befüllen und speichern

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Benny,
der von dir beschriebene Ablauf ist etwas schwierig zu realisieren.
Ich kann dir folgendes anbieten:
Bei einer Änderung in Spalte B wird die Datei "ÄnderungsA.xls" geöffnet und die Daten übertragen.
Solange die Datei "ÄnderungsA.xls" geöffnet ist, werden Änderungen in der gleichen Zeile übertragen.
Per Button-Klick (Button aus Symbolleiste "Steuerelement-Toolbox") wird die datei unter neuem Namen gespeichert.
Den Code muss du in der Datei "CR6Projekt.xls" im VBA-Editor unter der Tabelle speichern, in der die Einagen überwacht werden sollen.
Gruß
Franz


Private wbAenderung As Workbook, wksAenderung As Worksheet, lngZeile As Long
'Nachfolgende Pfade und Dateinamen anpassen
Private Const strPfadAenderung As String = "C:\Lokale Daten\test"
Private Const strDateiAenderung As String = "ÄnderungA.xls"
Private Const strPfad As String = "C:\Lokale Daten\test\Daten" 'Zielverzeichnis für neue  _
Dateien
Private Sub CommandButton1_Click()
'Änderungsdatei speichern
On Error GoTo Fehler
If wbAenderung Is Nothing Then
MsgBox "Es wurden noch keine Daten in Spalte B geändert!"
Else
wbAenderung.Activate
If MsgBox(Prompt:="Datei mit Daten zu Zeile " & lngZeile & " speichern?" & vbLf _
& "Dateiname: " & strPfad & "\" & wksAenderung.Range("B8").Text, _
Buttons:=vbYesNo) = vbYes Then
wbAenderung.SaveAs Filename:=strPfad & "\" & wksAenderung.Range("B8").Text
wbAenderung.Close
Set wksAenderung = Nothing
Set wbAenderung = Nothing
Else
ThisWorkbook.Activate
End If
End If
Fehler:
If Err.Number  0 Then
MsgBox "Fehler nr. " & Err.Number & vbLf & Err.Description
ThisWorkbook.Activate
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:F60")) Is Nothing And Target.Cells.Count = 1 Then
Select Case Target.Column
Case 2
'Case 2, bei Änderungen eines Werts in Spalte 2, wird Änderungsdatei schreibgeschützt geöffnet  _
_
oder neu zugewiesen falls schon geöffnet
If Not IsEmpty(Target) Then
If CheckWorkbookOpen(strDateiAenderung) = True Then
'Änderungsdatei ist schon geöffnet
Set wbAenderung = Workbooks(strDateiAenderung)
Else
'Änderungsdatei schreibgeschützt öffnen
Set wbAenderung = Workbooks.Open(Filename:=strPfadAenderung & "\" &  _
strDateiAenderung, _
ReadOnly:=True)
End If
'Tabellenblatt in Änderungsdatei setzen
Set wksAenderung = wbAenderung.Worksheets(1)
ThisWorkbook.Activate
'geänderte Zeile merken
lngZeile = Target.Row
'Daten in Änderungsdatei übertragen
wksAenderung.Range("B8") = Me.Cells(lngZeile, 3)
wksAenderung.Range("D10") = Me.Cells(lngZeile, 4)
wksAenderung.Range("E10") = Me.Cells(lngZeile, 5)
wksAenderung.Range("F10") = Me.Cells(lngZeile, 6)
End If
'Case 3 bis 6 übertragen Änderungen in den Spalten, wenn diese in der gemerkten Zeile erfolgen
Case 3
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("B8") = Target.Value
End If
Case 4
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("D10") = Target.Value
End If
Case 5
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("E10") = Target.Value
End If
Case 6
If Target.Row = lngZeile And Not wbAenderung Is Nothing Then
wksAenderung.Range("F10") = Target.Value
End If
Case Else
'do nothing
End Select
End If
End Sub
Private Function CheckWorkbookOpen(strName As String) As Boolean
'Prüfen, ob Arbeitsmappe strName schon geöffnet ist
Dim wb As Workbook
CheckWorkbookOpen = False
For Each wb In Workbooks
If UCase(wb.Name) = UCase(strName) Then
CheckWorkbookOpen = True
Exit For
End If
Next
End Function

Beliebteste Forumthreads (12 Monate)

Datei öffnen, befüllen und speichern

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Datei öffnen, befüllen und speichern

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread