Laufzeitfehler beim kopieren von Listboxergebnis
04.09.2019 17:00:49
Listboxergebnis
ich brauch mal eure wieder eurer fachliches KnowHow zu dem Thema Listbox..
Es gibt vielleicht eine elegantere Lösung als meine, aber dazu fehlt mir das VBA Know How.
Ich habe in einer Userform eine Listbox die sich Überschriften aus einem Referenzdatenblatt holt.
Durch Doppelklick einer der angezeigten Überschriften in der Listbox, sollen im Hintergrund die dazugehörigen Daten in eine Vorlage kopiert werden.
Mit viel Schweiss und Kaffee hab ich das auch soweit fast hinbekommen..
Die Userform wird über einen ComBottom auf einem Übersichtssblatt gestartet.
an der Stelle:
.Range(Cells(4, rSuche.Column), Cells(enZeile, eRow)).Copy
Streikt der Code und ich bekomm einen Laufzeitfehler '1004'
Anwendungs- oder Objektdefinierter Fehler.
Wenn ich auf dem Referenzdaten bin und die Userform starte, läuft der Code sauber durch.
Was hab ich da vergessen, oder nicht richtig gemacht'
anbei der Code zum Listbox befüllen:
'PAGE AUFRUFEN UND REFERENZEN AUFLISTEN
'SEITE BRÜHEINHEITENPRÜFUNG - GRUPPIERUNG
Private Sub UserForm_Initialize()
Dim xTop As Long
Dim xLeft As Long
Dim LSpalte As Long
Dim mB As Worksheet
Me.StartUpPosition = 0
With Application
xLeft = .Left + .Width / 1.5 - Me.Width / 2
xTop = .Top + .Height / 1.9 - Me.Height / 2
End With
With Me
.Left = xLeft
.Top = xTop
End With
MultiPage1.Style = fmTabStyleNone 'Ausblenden der Register in den Multiseiten
MultiPage2.Style = fmTabStyleNone 'Ausblenden der Register in den Multiseiten
With Sheets("Referenzdaten")
LSpalte = .Cells(2, Columns.Count).End(xlToLeft).Column
For a = 1 To LSpalte
If Not IsEmpty(.Cells(2, a)) Then
With ListBox2
.ColumnCount = 3
.ColumnWidths = "2.4cm;3.4cm;5cm"
.ColumnHeads = False
.TextColumn = 1
.BoundColumn = 2
.Font.Size = 8
.AddItem Sheets("Referenzdaten").Cells(2, a).Value
.List(.ListCount - 1, 1) = "| " & Sheets("Referenzdaten").Cells(2, a).Offset(-1, 0).Value
.List(.ListCount - 1, 2) = "| " & Sheets("Referenzdaten").Cells(2, a).Offset(-1, 3).Value
End With
End If
Next a
End With
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Integer
Dim rng As String
Dim rSuche As Object
Dim Treffer1 As String
Dim eRow As Integer
Dim stZeile As Integer
Dim enZeile As Integer
With ListBox2
For i = 0 To .ListCount - 1
If UfGlobaleEinstellung.ListBox2.Selected(i) = True Then
rng = UfGlobaleEinstellung.ListBox2.List(i, 0)
Set rSuche = Worksheets("Referenzdaten").Rows(2).Find(What:=rng).Columns
If Not IsError(rSuche) Then
MsgBox ("Referenzdaten der Brüheinheit " & rng & " werden übernommen" & vbLf & vbLf & " _
Reference data of the brewing unit " & rng & " will be transfered")
Worksheets("Datentabelle").Range("I2").ClearContents
'Überschrift der Brüheinheitentabelle wird gelöscht
Worksheets("Datentabelle").Range("I3:N1103").ClearContents
'Tabelle P1Sollwert bis Motorposition wird gelöscht
eRow = rSuche.Column + 4
'Gefundene Brüheinheiten aus Referenzliste plus 4 Spalten
stZeile = 4
' ab Zeile kopieren
With Worksheets("Referenzdaten")
enZeile = .Cells(Rows.Count, eRow).End(xlUp).Row
'maximale Zeilen aus Motorposition werden ermittelt
da meckert er---> .Range(Cells(4, rSuche.Column), Cells(enZeile, eRow)).Copy
'Referenztabelle der gefundenen Brüheinheit wird kopiert
Worksheets("Datentabelle").Cells(4, 9).PasteSpecial Paste:=xlPasteValues
'und in die Datentabelle kopiert
End With
End If
End If
Next i
End With
End Sub
Habt ihr eine Idee wie ich das realsisieren kann ohne extra auf das Blatt zu springen?
Bzw. wie mach ich das wenn per doppelklick aus der Listbox ?
über eure Hilfe und Idee wäre ich dankbar.
liebe grüsse
Christian