Thema Datum  Von Nutzer Rating
Antwort
01.06.2017 09:42:16 PSCH
NotSolved
04.06.2017 15:05:42 BigBen
***
NotSolved
04.06.2017 19:16:17 BigBen
NotSolved
06.06.2017 07:55:04 Gast47675
NotSolved
06.06.2017 07:58:28 PSCH
NotSolved
06.06.2017 13:51:27 BigBen
*****
NotSolved
06.06.2017 15:49:55 PSCH
NotSolved
07.06.2017 06:13:30 BigBen
NotSolved
07.06.2017 08:43:20 PSCH
NotSolved
07.06.2017 14:51:57 BigBen
Solved
07.06.2017 15:55:42 PSCH
Solved
Blau Neue Excel Datei öffnen und Button rein kopieren
08.06.2017 13:35:00 BigBen
Solved
08.06.2017 20:28:57 PSCH
Solved

Ansicht des Beitrags:
Von:
BigBen
Datum:
08.06.2017 13:35:00
Views:
662
Rating: Antwort:
 Nein
Thema:
Neue Excel Datei öffnen und Button rein kopieren

Hallo,

um die zusätzlichen Inhalte kopieren zu können muss die Sub ausgetauscht werden:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim strFilename As String
    Dim strValue As String
    Dim wbk As Workbook
    Dim rng As Range
    Set rng = refersToRange("Buttons")
    If Not Intersect(rng, Target) Is Nothing Then
        strFilename = ThisWorkbook.Path & "\autoFile_2.xlsm"
        Set wbk = GetWorkbook(strFilename)
        If wbk Is Nothing Then
            Set wbk = Application.Workbooks.Open(filename:=strFilename)
        Else
            wbk.Activate
        End If
        
        ' B18 <- A3:A502
        strValue = Target.Cells(1, 1).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B18").Value = strValue
        End If
        
        ' B11 <- E3:E502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=4).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B11").Value = strValue
        End If
        
        ' B12 <- F3:F502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=5).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B12").Value = strValue
        End If
        
        ' G10 <- G3:G502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=6).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("G10").Value = strValue
        End If
        
        ' B9 <- H3:H502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=7).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B9").Value = strValue
        End If
        

        ' --> Weitere zu kopierende Inhalte müssen hier eingesetzt werden <--

    End If
End Sub

Bei Bedarf muss wieder der Pfad  und Dateiname zu der nachzuladenden Arbeitsmappe angepasst werden.

Falls noch weitere Inhalte nach dem gleichen Muster in eine andere Zelle der nachzuladenden Arbeitsmappe kopiert werden sollen, müssen lediglich die nachstehenden Zeilen angepast und unter die bestehenden Zeilen hinzugefügt werden:

Bsp: Inhalte der Zeilen K3-K502 sollen in die Zelle H3 kopiert werden:

        ' H3 <- K3:K502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=10).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("H3").Value = strValue
        End If

LG, BigBen


Ihre Antwort
  • 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: Name: Email:



  • 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
01.06.2017 09:42:16 PSCH
NotSolved
04.06.2017 15:05:42 BigBen
***
NotSolved
04.06.2017 19:16:17 BigBen
NotSolved
06.06.2017 07:55:04 Gast47675
NotSolved
06.06.2017 07:58:28 PSCH
NotSolved
06.06.2017 13:51:27 BigBen
*****
NotSolved
06.06.2017 15:49:55 PSCH
NotSolved
07.06.2017 06:13:30 BigBen
NotSolved
07.06.2017 08:43:20 PSCH
NotSolved
07.06.2017 14:51:57 BigBen
Solved
07.06.2017 15:55:42 PSCH
Solved
Blau Neue Excel Datei öffnen und Button rein kopieren
08.06.2017 13:35:00 BigBen
Solved
08.06.2017 20:28:57 PSCH
Solved