VBA-Codes verbinden
04.04.2017 09:38:32
Thomas
ich bitte um Hilfe bei folgendem Problem. Ich hab zwei Codes die ich über jeweils einen Aktionsbutton betätige. Es würde aber mehr Sinn machen diese zu verknüpfen und nur noch über einen Button auszuführen.
Zur Beschreibung: der erste code filtert aus einer Datenreihe die wichtigsten Daten und tägt sie mir untereinander in eine Liste ein (das soll auch so bleiben). Bei betätigen des zweiten Codes erscheint zunächst eine Msg-box in der ich eine Nummer eintragen die dann in der Range von A3-A500 gesucht wird( A3=1/A500=503)-> wegen dem Tabellenkopf Nummerierung verändert. Wenn ich also die 3 eingebe wird die erste Zeile der Liste gedruckt von B-J Spalte.
Mein Wunsch:
nach einfügen der Daten in die Zeile die verfügbar ist in der Liste soll diese Zeile auch gedruckt werden.
hier die codes:
1. Filtern und untereinander eintragen
Sub zht()
Dim WS2 As Worksheet
Dim letzteZeile As Long
Set WS2 = Worksheets("Tabelle2")
Application.DisplayAlerts = False
Range("G1").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
)), TrailingMinusNumbers:=True
Application.DisplayAlerts = True
letzteZeile = WS2.Cells(Rows.Count, 3).End(xlUp).Row + 1
WS2.Range(WS2.Cells(letzteZeile, 3), WS2.Cells(letzteZeile, 6)) = WS2.Range("AC1:AF1").Value
WS2.Range("G1:S1").ClearContents
End Sub
2. Über Messagebox die Zeile Drucken
Public Sub drucken()
Dim varSuche As Variant
Dim rngFund As Range
Anfang:
varSuche = Application.InputBox(prompt:="Bitte Nummer eingeben:", Type:=2)
If varSuche = False Then Exit Sub
If IsNumeric(varSuche) Then
'### Tabellenblatt an deine Bedürfnisse anpassen ###
Set rngFund = Sheets("Tabelle2").Columns(1).Find(What:=varSuche, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rngFund Is Nothing Then
'### Tabellenblatt an deine Bedürfnisse anpassen ###
With Sheets("Tabelle2")
Application.ScreenUpdating = False
.Columns(1).Hidden = True
.Range(.Cells(rngFund.Row, 1), .Cells(rngFund.Row, 6)).PrintPreview
.Columns(1).Hidden = False
Application.ScreenUpdating = True
End With
Else
MsgBox "Nummer " & varSuche & " nicht gefunden."
End If
ElseIf Not IsNumeric(varSuche) And varSuche "" Then
MsgBox "Nur Zahlen erlaubt."
GoTo Anfang
End If
End Sub
Gruß Thomas