VBA funktioniert mal und mal nicht
30.12.2005 18:36:03
drigi
habe folgendes Makro erstellt und manches mal Probleme damit. So funktioniert es im Visual-Basic-Editor bei Ausführung der Einzelprozedur, aber nicht über eine Schaltfläche. Dann bleibt das Tabellenblatt Artikel leer. Zudem fehlt bei jedem Mal ausführen die erste Spalte ganz links bis keine Spalten mehr da sind.
Auch zerstört es meine Formeln in meinem anderen Tabellenblatt. Es steht dann da "Bezug". Ich lösche doch nur den Inhalt!?
Wer kann mir helfen. Sollten noch Fragen sein: Antwort kommt kurzfristig!
Danke für die Hilfe...
Sub Fertig()
Application.ScreenUpdating = False
Sheets("Artikel").Select
'Sheets("Artikel").Unprotect Password:="jd2210"
Dim wb1 As Workbook, wb2 As Workbook
Dim offen As Boolean, Datei1 As String, Datei2 As String
Dim Tab1 As String, Pfad As String
Datei1 = "Rechnung.xls" 'Dateiname für Rechnungs-Datei
Datei2 = "Bestellung2.xls" 'Dateiname der Bestell-Datei
Tab1 = "Artikel" 'Tabellenname der Artikeltabelle (ist in beiden Dateien gleich!)
Pfad = "E:\Office-Daten\Jocoda Deutschland" 'Verzeichnis der Rechnungsdatei
'Überprüfung ob Rechnungs-Datei geöffnet ist
offen = False
For Each Datei In Workbooks
If Datei.Name = Datei1 Then
offen = True
Exit For
End If
Next Datei
If offen = False Then
Workbooks.Open Filename:=Pfad & "\" & Datei1
Else
Workbooks(Datei1).Activate
End If
Set wb1 = Workbooks("Rechnung.xls")
Set wb2 = Workbooks("Bestellung2.xls")
'Löschen Inhalt Blatt Artikel in wb2
'Ausschalten der (lästigen?) Nachfrage, ob wirklich gelöscht werden soll
Application.DisplayAlerts = False
On Error Resume Next
wb2.Worksheets("Artikel").Cells.Select
Selection.ClearContents
Application.DisplayAlerts = True
'Kopieren des Inhaltes des Blattes Artikel von Rechnung
wb1.Worksheets("Artikel").Cells.Select
ActiveWindow.SmallScroll Down:=-3
Selection.Copy
'Einfügen des Inhaltes des Blattes Artikel von Rechnung nach Bestellung
wb2.Worksheets("Artikel").Range("A1").Select
ActiveSheet.Paste
Set wb1 = Nothing
Set wb2 = Nothing
'ggf. Rechnungs-Datei wieder schließen
If offen = False Then
Workbooks(Datei1).Close SaveChanges:=False
End If
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
ActiveWorkbook.Names("Artikel").Delete
Range("A1").Select
'Sheets("Artikel").Protect Password:="jd2210"
Application.ScreenUpdating = True
End Sub