Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1116to1120
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Problem

VBA Problem
Karadag
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
versuche es mal so.
14.11.2009 16:56:34
Tino
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
Anzeige
AW: versuche es mal so.
15.11.2009 13:33:46
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
AW: versuche es mal so.
15.11.2009 13:49:51
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
Anzeige
AW: versuche es mal so.
15.11.2009 14:39:47
Tino
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
Anzeige
AW: versuche es mal so.
15.11.2009 18:19:26
Karadag
Hallo Tino!
Herzlichen Dank, es funktioniert einwandfrei!
Gruß, Karadag
AW: wenn es funktioniet und
15.11.2009 20:29:21
Daniel
das Problem gelöst ist, solltest du die Frage nicht mehr auf offen stellen
Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige