Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1088to1092
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
VBA Speichern unter
Alexander
wie kann ich bei folgendem "speichern unter" das Abbrechen unterdrücken/deaktivieren da ich sonst eine fehlermeldung bekomme ?
Sub Exportieren Aktualiesieren()
' Kopieren aktueller stand in alten Stand
Range("A6:L98").Copy
Sheets("Alter Stand").Select
Range("a4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabetabelle").Select
Range("F1").Copy
Sheets("Alter Stand").Select
Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Kopieren der Neuerungen und Zusamenfassen sowie speichern unter
Range("T6:AU99").Copy
Sheets("Endstellenbelegung").Visible = True
Sheets("Endstellenbelegung").Select
Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
Worksheets("Endstellenbelegung").Copy
VorlPfad = "C:"
gDir = VorlPfad
ChDrive Left(gDir, 2)
ChDir gDir
'Dialog öffnen
Application.Dialogs(xlDialogSaveAs).Show
Dim rng As Range
For Each rng In Range("A4:R99")
If rng.Value = 0 Then rng.ClearContents
Next
Dim i As Long, laR As Long
Application.ScreenUpdating = False
On Error Resume Next
laR = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
On Error GoTo 0
If laR = 0 Then Exit Sub
For i = laR To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
Range("A4").Select
Windows("test3.xls").Activate
Sheets("Eingabetabelle").Select
Range("A6").Select
Sheets("Endstellenbelegung").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Eingabetabelle").Select
Dim Zelle As Range
Dim lngA As Long
Dim lngB As Long
For Each Zelle In Range("M6:R99")
lngA = Range(Zelle.Address).Row
lngB = Range(Zelle.Address).Column
If Zelle  "" Then Cells(lngA, lngB - 6) = Zelle
Next
Range("M6:R99").ClearContents
Range("A6:L98").Copy
Sheets("Alter Stand").Select
Range("o4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Sheets("Eingabetabelle").Select
Range("F1").Copy
Sheets("Alter Stand").Select
Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabetabelle").Select
Range("A6").Select
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
Hat sich erledigt war ein fehler von mir
25.07.2009 10:08:55
mir
Hatte vergessen nach Dateinamensänderung test5.xls
Windows("test3.xls").Activate
umzubennenen
Sorry
Trozdem Danke
Anzeige

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige