Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
31.05.2017 19:24:10 |
Vale |
|
|
Namen von Arbeitsmappe "X" in Arbeitsmappe "Y" kopieren, wenn nicht vorhanden |
05.06.2017 18:14:05 |
BigBen |
|
|
|
06.06.2017 18:40:51 |
Vale |
|
|
|
07.06.2017 07:21:36 |
BigBen |
|
|
|
07.06.2017 18:59:42 |
Vale |
|
|
Von:
BigBen |
Datum:
05.06.2017 18:14:05 |
Views:
603 |
Rating:
|
Antwort:
|
Thema:
Namen von Arbeitsmappe "X" in Arbeitsmappe "Y" kopieren, wenn nicht vorhanden |
Hallo,
dieser Code sollte das gewünschte Vorhaben umsetzen:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wbk As Workbook
Dim rngNew As Range
Dim strFilename As String
strFilename = ThisWorkbook.Path & "\Übersicht.xlsx"
Set wbk = GetWorkbook(strFilename)
If wbk Is Nothing Then
Set wbk = Application.Workbooks.Open(strFilename)
ThisWorkbook.Activate
End If
For Each rngNew In Target.Cells
If rngNew.Row >= 4 Then
' Existiert der gesuchte Eintrag in einer anderen Zelle?
If WorksheetFunction.CountIf(Target.Worksheet.Range("A4:A1048576"), rngNew.value) = 1 Then
FillOverviewWorkbook wbk, rngNew.value
End If
End If
Next
End Sub
Private Function GetWorkbook(sFilename As String) As Workbook
Dim wbk As Workbook
For Each wbk In Application.Workbooks
If wbk.FullName = sFilename Then
Set GetWorkbook = wbk
Exit For
End If
Next
End Function
Private Sub FillOverviewWorkbook(wbk As Workbook, value As String)
Dim rng As Range
Dim rngCheck As Range
Dim wsh As Worksheet
Set wsh = wbk.Worksheets(1)
Set rng = wsh.Range("A10:A1048576")
If rng.Find(what:=value) Is Nothing Then
' Freie Zelle finden
For Each rngCheck In rng.Cells
If IsEmpty(rngCheck) Then
Exit For
End If
Next
' Neuen Eintrag anlegen
If Not rngCheck Is Nothing Then
rngCheck.value = value
End If
End If
End Sub
Vorausetzung: Die Arbeitsmappen "Übersicht.xlsx" und "Kursteilnehmer.xlsm" müssen im gleichen Verzeichnis gespeichert sein.
Beide Muster-Arbeitsmappen können hier heruntergeladen werden.
LG, BigBen
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
31.05.2017 19:24:10 |
Vale |
|
|
Namen von Arbeitsmappe "X" in Arbeitsmappe "Y" kopieren, wenn nicht vorhanden |
05.06.2017 18:14:05 |
BigBen |
|
|
|
06.06.2017 18:40:51 |
Vale |
|
|
|
07.06.2017 07:21:36 |
BigBen |
|
|
|
07.06.2017 18:59:42 |
Vale |
|
|