VBA-Excel Code: Suche nach bestimmtem Wert und kopiere Bereiche einer Zeile in ein anderes Blatt

[Belacor96]

Hallo zusammen,

ich hoffe hier ist mein Betrag richtig aber ich bin mit meinem Latein etwas am Ende.

Ich erstelle gerade eine Excel Datei welche mit VBA Codes funktionieren soll. Hierfür sollen über ein Blatt in 8 Spalten diverse Einträge erfolgen und über einen Button kopiere ich diese Einträge in ein zweites Blatt.

Dort wird jeder neue Eintrag untereinander erstellt und dient so als sicherer Speicherort. Jede Zeile ist dort mit einer Nummer am Ende versehen.

Dies funktioniert bisher auch einwandfrei und wunschgemäß.

Da das zweite Blatt jedoch Passwortgeschützt ist (soll keiner versehentlich etwas löschen) aber es dennoch vorkommt dass man hier eine Änderung vornehmen soll, habe ich versucht einen weiteren Code zu schreiben.

Ich will über eine Zelle auf Blatt 1 (C15) die Zeilennummer eintragen können und anschließend kopiert er mir die entsprechende Zeile (bis Spalte H) von Blatt 2 in die vorgesehenen Felder auf Blatt 1 (Zeile 18). Dort will ich die Felder editieren können und anschließend wieder über einen anderen Button zurück auf Blatt 2 kopieren und den Eintrag auf Blatt 1 löschen.

Die Liste wird beruflich von mehreren Personen genutzt. Daher das löschen, kopieren, etc.

Der erste Code für Neueinträge funktioniert ohne Probleme:

Sub Zeile_kopieren()
'Da fehlt was
If Tabelle1.Range("A2").Value = "" Then
MsgBox ("Datumsangabe fehlt")
End If
If Tabelle1.Range("B2").Value = "" Then
MsgBox ("Bearbeiter fehlt")
End If
If Tabelle1.Range("C2").Value = "" Then
MsgBox ("Kordoba ID fehlt")
End If
If Tabelle1.Range("D2").Value = "" Then
MsgBox ("Kundenname fehlt")
End If
If Tabelle1.Range("E2").Value = "" Then
MsgBox ("Name + Ansprechperson andere Bank fehlt")
End If
If Tabelle1.Range("F2").Value = "" Then
MsgBox ("Info über Case-Anlage in Actimize fehlt")
End If
If Tabelle1.Range("G2").Value = "" Then
MsgBox ("Sachverhalt fehlt")
End If
If Tabelle1.Range("H2").Value = "" Then
MsgBox ("Case ID fehlt")
End If

If Tabelle1.Range("A2").Value = "" Then Exit Sub
If Tabelle1.Range("B2").Value = "" Then Exit Sub
If Tabelle1.Range("C2").Value = "" Then Exit Sub
If Tabelle1.Range("D2").Value = "" Then Exit Sub
If Tabelle1.Range("E2").Value = "" Then Exit Sub
If Tabelle1.Range("F2").Value = "" Then Exit Sub
If Tabelle1.Range("G2").Value = "" Then Exit Sub
If Tabelle1.Range("H2").Value = "" Then Exit Sub

'MSG Box
Dim strFrage As String
strFrage = MsgBox("Soll der Eintrag gespeichert werden?" & Space(10), _
vbYesNo + vbQuestion, "Löschen")
If strFrage = vbNo Then Exit Sub
'Bereich kopieren
Sheets("Anrufe anderer Banken").Range("A2:H2").Copy
'einfügen in erste freie Zeile in Log
Sheets("Log").Unprotect ("Zitronensorbet1337")
Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = Sheets("Anrufe anderer Banken").Range("A2:H2").Value
Sheets("Log").Protect ("Zitronensorbet1337")
'Kopiermodus beenden
Application.CutCopyMode = False
'Löschen
ActiveSheet.Unprotect ("Zitronensorbet1337")
Range("A2:H2").ClearContents
ActiveSheet.Protect ("Zitronensorbet1337")
End Sub




Der Zweite Code zum "laden" von Einträgen aufgrund der Suche mit Hilfe der Zeilennummer sowie das anschließende Überschreiben geht überhaupt nicht. Ich scheitere leider schon an der Such und kopier rüber Funktion.

Das waren jetzt meine ersten Versuche aber es klappt nicht...:
Sub AltenEintragladen()
'Da fehlt was
If Tabelle1.Range("C15").Value = "" Then
MsgBox ("Bitte Eintragsnummer erfassen")
End If

If Tabelle1.Range("C15").Value = "" Then Exit Sub
Dim rng As Range
Dim loDeinWert As Long

loDeinWert = ("C15") 'gesuchter Wert

Set rng = Worksheets("Log").Range("I:I").Find(loDeinWert)
If rng Is Nothing Then
MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Else
Set rng = Worksheets("Log").Range("E:E").Find(loDeinWert, LookAt:=xlWhole)
Range("A" & rng.Row & ":E" & "E" & rng.Row).Copy
Worksheets("Anrufe anderer Banken").Range("A18").PasteSpecial Paste:=xlPasteAll
End If
End Sub



Ich würde mich super freuen wenn ihr mir hier helfen könnt bzw. auch einen Code zum zurück kopieren und überschreiben habt (natürlich in die entsprechende richtige Zeile).

Vielen Dank vorab für Eure Hilfe.

Viele Grüße
Belacor96

 

[Belacor96]

Anbei zur Veranschaulichung jeweils Blatt 1 und 2.

 

[taks]

Schau mal hier: Wert in Spalte finden und Zeilenzahl zurückgeben Office-Loesung.de

So kannst du die Zeilen durchsuchen.
Musst nur das Log Blatt angeben und in "such" die gesuchte Nummer definieren.

Private Sub CommandButton1_Click()
    Dim lfdNr As Integer
    Dim lfdA  As String
    Dim such As Integer

    For lfdNr = 1 To 15
        For such = 1 To 15
            If Cells(such, 1).Value = lfdNr Then
                lfdA = Cells(such, 1).Row
                MsgBox "Lfd.Nr.: " & lfdNr & " befindet sich in Zeile: " & lfdA
            End If
        Next such
    Next lfdNr
End Sub

Dann noch wie du die Werte in Log schreibst, die Werte von der gesuchten Zeile in das Anrufe Blatt schreiben.

 

[Belacor96]

Hi,

danke für die schnelle Antwort.

Ich versuch es morgen mal... Kenne mich jetzt leider nur nicht so gut mit VBA aus.

Wo genau definiere ich da das er in "Log" nach dem Eintrag aus "Anruf" sucht, also nach der jeweiligen Zeile. Bei such? Weil ich habe ja keine feste Zahl sondern gebe die durch Eingabe in "Anruf" vor und die ändert sich auch je nachdem.

Sofern es dann das ist wird ja die jeweilige Zahl gesucht.

Wie bekomm ich es denn dann noch hin das er mir die jeweiligen Einträge der Zeile in Zeile 18 in Anruf kopiert? Und genau das selbe dann zurück?

VBA und ich sind manchmal echt keine Freunde...

 

[taks]

Ich mache mein VBA Zeug eigentlich nur mit Hilfe von Google und Trial&Error.
Für die Male wo ich es brauche wäre alles auswendig zu lernen Overkill ^^

Aber als Beispiel wie man andere Files oder Worksheets (Rot gekennzeichnet) anspricht:

Dim wkbOrig As Workbook
Dim wkbTarg As Workbook
Set wkbOrig = ThisWorkbook
    
intTest = 0
intAnzahlURL = 34
intMonat = Month(Now())
    
    ' Alle URLS
    For i = 5 To intAnzahlURL
          
        'Pfad Mitarbeiter Zeittabelle path zuweisen
        path = Worksheets("Mitarbeiter Tabellen").Cells(i, 3).Value
             
        If Len(Worksheets("Mitarbeiter Tabellen").Cells(i, 3).Value) = 0 Then
        'Wenn Pfad nicht hinterlegt ist alles leeren
          
        [COLOR="#FF0000"]wkbOrig.Sheets("Detail").Cells((intDetailCount * 6) + 2, 2) = " "
                       
        ' Januar
        ' Arbeitszeit
        wkbOrig.Sheets("Detail").Cells((intDetailCount * 6) + 4, 3) = ""

 

[TessaKavanagh]

Dumme Frage, aber wenn mehrere Leute damit arbeiten sollen, warum nutzt du dann nicht einfach eine zentral liegende Datenbank als Speicherort?

Du kannst übrigens in EXCEL per VBA auch ganze Tabellenblätter "verstecken", dann können diese durch keinen Nutzer oder Script versehentlich bearbeitet werden. Die passende Int im Visible Attribut dafür ist 2 auch bekannt als "Very Hidden". Das ist effektiver als jeder Passwortschutz, da kommt nämlich keiner auf die Idee mal zu probieren ob er das Passwort errät