Thema: VBA Problem | Herbers Excel-Forum

Hallo Forumsmitglieder,
ich habe folgendes Problem:
unten dargestellten VBA Kode verwende ich von einem Excel Datei bestimmte variable (Außer D7) Zellen zu anderem Excel Datei an bestimmte Zellen zu übertragen. Mein Problem ist gewollte Übertragung nicht immer sauber funktioniert manchmal wird gar nichts übertragen und manschmall nicht an vordefinierten Zellen übertragen. Wo habe ich den Fehler und wie kann ich korrigieren. Danke im voraus für nette Hilfe.

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Abbrechen As Boolean)
Worksheets("Envanter").Activate
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWindow.ActivateNext
Kod = Range("D7").Value
h61 = Range("h61").Value
h63 = Range("h63").Value
h65 = Range("h65").Value
e61 = Range("e61").Value
e63 = Range("e63").Value
e65 = Range("e65").Value
r67 = Range("r67").Value
o67 = Range("o67").Value
Workbooks.Open ("D:\Ofis\Papatya\Envanterler\Envanter.xls")
Range("A:A").Select
Cells.Find(What:=Kod).Activate
ActiveCell.Offset(0, 3).Value = h61
ActiveCell.Offset(0, 4).Value = h63
ActiveCell.Offset(0, 5).Value = h65
ActiveCell.Offset(0, 7).Value = e61
ActiveCell.Offset(0, 8).Value = e63
ActiveCell.Offset(0, 9).Value = e65
ActiveCell.Offset(0, 10).Value = r67
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Hallo,
bei verwenden von Find sollte man besser alle Parameter angeben (siehe auch in der Hilfe),
sonst kann es durch eine zuvor gemachte Suche z. Bsp. von Hand zu Fehlern kommen
wegen der Einstellungen in der Suche die nicht zurückgesetzt werden.
Zudem sollte man immer die Variablen Deklarieren, da ich aber nicht weis, welche Werte bei dir in den Zellen stehen habe ich jetzt einfach mal Variant verwendet.
Habe den Code nicht getestet!

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Abbrechen As Boolean)
Dim oWB As Workbook, rngRange As Range, rngSuchZelle As Range
Dim varWerte(0 To 7) As Variant 'Array für die Daten 
Dim varSuchWert As Variant 'Variable für die Suche 


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets("Envanter").Activate
ActiveWindow.ActivateNext
 
varSuchWert = Range("D7").Value
varWerte(0) = Range("h61").Value
varWerte(1) = Range("h63").Value
varWerte(2) = Range("h65").Value
varWerte(3) = Range("e61").Value
varWerte(4) = Range("e63").Value
varWerte(5) = Range("e65").Value
varWerte(6) = Range("r67").Value
varWerte(7) = Range("o67").Value '? siehe unten 

Set oWB = Workbooks.Open("D:\Ofis\Papatya\Envanterler\Envanter.xls")
Set rngRange = oWB.Sheets("Tabelle1").Range("A:A") 'Tabellenname anpassen 

Set rngSuchZelle = rngRange.Find(What:=varSuchWert, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not rngSuchZelle Is Nothing Then 'wurde Suchwert gefunden? 
    With rngSuchZelle
        'Daten Übertragen ********************************************************* 
        .Offset(0, 3).Value = varWerte(0)
        .Offset(0, 4).Value = varWerte(1)
        .Offset(0, 5).Value = varWerte(2)
        .Offset(0, 7).Value = varWerte(3)
        .Offset(0, 8).Value = varWerte(4)
        .Offset(0, 9).Value = varWerte(5)
        .Offset(0, 10).Value = varWerte(6)
        .Offset(0, 11).Value = varWerte(7) '? wurde in Deinem Code nicht Übertragen 
        '************************************************************************** 
    
        Set rngSuchZelle = Nothing
    End With
    
    oWB.Close True 'speichern und schließen 
Else
    oWB.Close False 'schließen ohne speichern 
    MsgBox "'" & varSuchWert & "' wurde nicht gefunden!"
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set oWB = Nothing: Set rngRange = Nothing
End Sub

Gruß Tino

Hallo Tino,
Danke Dir, funktioniert! Eine Frage evt. noch: Wenn ich zusätzlich ein zweiten Workbook ("D:\Ofis\Papatya\FaturaBilgileri\FaturaBilgileri.xls") auf mache und gleichen find Funktionen verwende, gelesenen werte von E65 auf spalte "C" einfügen will kann ich eventuell in der gleichen Code (die von dir korrigierten) mit integrieren. Wenn ja bitte um deine Hilfe. Besten Dank im Voraus und Schönen Sonntag noch.
Karadag

Hallo Tino,
Danke Dir, funktioniert! Eine Frage evt. noch: Wenn ich zusätzlich ein zweiten Workbook ("D:\Ofis\Papatya\FaturaBilgileri\FaturaBilgileri.xls") auf mache und gleichen find Funktionen verwende, gelesenen werte von E65 auf spalte "C" einfügen will kann ich eventuell in der gleichen Code (die von dir korrigierten) mit integrieren. Wenn ja bitte um deine Hilfe. Besten Dank im Voraus und Schönen Sonntag noch.
Karadag

Hallo,
kann man schon, wird aber nach meiner Meinung zu unübersichtlich.
Ich würde für Dich empfehelen, zwei Makros draus zu machen und beide im Save Event aufrufen
Also so.
In ein Modul stellst Du Deine zwei Makros.

Sub SchreibeInDatei1 ()
End Sub
Sub SchreibeInDatei2 ()
End Sub

und im EventMakro so

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Abbrechen As Boolean)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call SchreibeInDatei1
Call SchreibeInDatei2
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

In den Makros natürlich ohne die Application.ScreenUpdating u. Application.DisplayAlerts
die legen wir ins Eventmakro.
Gruß Tino

Hallo Tino!
Herzlichen Dank, es funktioniert einwandfrei!
Gruß, Karadag

das Problem gelöst ist, solltest du die Frage nicht mehr auf offen stellen
Gruß, Daniel