Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1176to1180
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

Fehlermeldung: Cannot empty the clip board

Fehlermeldung: Cannot empty the clip board
abu
Guten Morgen liebes Forum,
hab ein kleines Problem und hoffe das Ihr mir helfen koennt.
Habe mir ein Makro gebastelt welches folegenden Ablauf hat:
Insgesamt 3 Tabellen und mit jeder Tabelle wird folgendes gemacht:
1. diverse formatierungen
2. Filter setzen und von jeder Zeile ein ausdruck
3. Daten der Tabelle in eine ander geschlossene Arbeitsmappe kopieren
Meistens bei der 2. Tabelle die bearbeitet wird stopt das Makro und spuckt die Fehlemeldung:
Cannot empty the clip board!
Ich vermute mal das es irgendwas mit dem Zwischenablage zu tun hat.
Hat jemand eine Loesung wie ich das Problem umgehen kann?
Danke im voraus.
Gruss
abu
AW: Fehlermeldung: Cannot empty the clip board
29.09.2010 10:24:13
xr8k2
Hallo abu,
du solltest dein Makro mal posten.
Gruß,
xr8k2
AW: Fehlermeldung: Cannot empty the clip board
29.09.2010 10:27:55
abu
Hallo xr8k2,
hier ist das Makro:
Option Explicit
Sub Test1()
Dim RV As Workbook
Dim z As Integer
Dim ASN As String
Dim x As Integer
Dim rngG As Range, oFilter As Object, i As Integer
Dim ar As Variant
Dim a As Integer
'Sicherheitskopie mit der gearbeitet wird
ActiveWorkbook.SaveAs "H:\Templates\Tempfile.xls"
'Pfad fuer ASNDatei
ASN = "G:\Sites\Beringe2\Kyocera\KME\Warehouse\Returns\ASNs completed inventorynieuw\ASNs completed inventorynieuw.xls"
'Variablenname fuer diese Datei
Set RV = ThisWorkbook
'*******Sheet1 Warehouse DHL
If WorksheetExists("WarehouseDHL") Then
'2 Spalten einfuegen, benennen und format uebernehmen
With Worksheets("WarehouseDHL")
Worksheets("WarehouseDHL").Activate
If Cells(2, 1).Value "" Then
With Worksheets("WarehouseDHL")
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Cells(1, 1).Value = "Week"
Cells(1, 2).Value = "DHL / non DHL"
Range("C1").Select
Selection.Copy
Range("A1:B1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells(1, 1).Select
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A1:L" & z).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'Wochennummer einfuegen
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A2:A" & z).Value = dt_Kalenderwoche(Date)
'aufsteigend sortieren nach LUID
Range("A1:L" & z).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'formatierung zum drucken
Cells.Select
Cells.EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 15.5
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'Schleife fuer drucken
Set oFilter = CreateObject("Scripting.dictionary")
For Each rngG In Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))
oFilter(rngG.Value) = rngG.Value
Next
ar = oFilter.Keys
For i = 0 To UBound(ar)
Cells(1, 1).AutoFilter Field:=5, Criteria1:=ar(i)
ActiveSheet.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
Next
ActiveSheet.ShowAllData
With Worksheets("WarehouseDHL")
'Spalte fuer 2010 einfuegen
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Cells(1, 3).Value = "Year"
Range("D2:D" & z).Value = Year(Now)
End With
'alles markieren und kopieren
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
' file oeffnen
Application.Workbooks.Open Filename:=ASN, UpdateLinks:=False
If ActiveWorkbook.ReadOnly Then
MsgBox "Workbook is in use at the moment. Please try again later"
ActiveWorkbook.Close SaveChanges:=False
Exit Sub
End If
Worksheets("completed whd").Activate
With Worksheets("completed whd")
x = 6250
While .Cells(x, 1) ""
x = x + 1
Wend
Cells(x, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=True
End With
End If
End With
End If
If WorksheetExists("RETURNS") Then
'*******Sheet RETURNS
Workbooks("Tempfile.xls").Activate
Worksheets("RETURNS").Activate
With Worksheets("RETURNS")
If Cells(2, 1).Value "" Then
Workbooks("Tempfile.xls").Activate
Worksheets("RETURNS").Activate
With Worksheets("RETURNS")
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Cells(1, 1).Value = "Week"
Cells(1, 2).Value = "DHL / non DHL"
Range("C1").Select
Selection.Copy
Range("A1:B1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells(1, 1).Select
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A1:L" & z).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'Wochennummer einfuegen
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A2:A" & z).Value = dt_Kalenderwoche(Date)
'aufsteigend sortieren nach LUID
Range("A1:L" & z).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'formatierung zum drucken
Cells.Select
Cells.EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 15.5
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'Schleife fuer drucken
Set oFilter = CreateObject("Scripting.dictionary")
For Each rngG In Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))
oFilter(rngG.Value) = rngG.Value
Next
ar = oFilter.Keys
For i = 0 To UBound(ar)
Cells(1, 1).AutoFilter Field:=5, Criteria1:=ar(i)
ActiveSheet.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
Next
ActiveSheet.ShowAllData
'alles markieren und kopieren
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
' file oeffnen
'Application.Workbooks.Open Filename:=ASN, UpdateLinks:=False
Application.Workbooks.Open Filename:=ASN, UpdateLinks:=False
Workbooks("ASNs completed inventorynieuw.xls").Activate
Worksheets("completed returns").Activate
With Worksheets("completed returns")
x = 6800
While .Cells(x, 1) ""
x = x + 1
Wend
Cells(x, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=True
End With
End If
End With
End If
If WorksheetExists("Warehouse not DHL") Then
'*******Sheet Warehouse not DHL
Workbooks("Tempfile.xls").Activate
Worksheets("Warehouse not DHL").Activate
With Worksheets("Warehouse not DHL")
If Cells(2, 1).Value "" Then
Workbooks("Tempfile.xls").Activate
Worksheets("Warehouse not DHL").Activate
With Worksheets("Warehouse not DHL")
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Cells(1, 1).Value = "Week"
Cells(1, 2).Value = "DHL / non DHL"
Range("C1").Select
Selection.Copy
Range("A1:B1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells(1, 1).Select
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A1:L" & z).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'Wochennummer einfuegen
z = 2
While .Cells(z, 3) ""
z = z + 1
Wend
z = z - 1
Range("A2:A" & z).Value = dt_Kalenderwoche(Date)
'aufsteigend sortieren nach LUID
Range("A1:L" & z).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'formatierung zum drucken
Cells.Select
Cells.EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 15.5
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'Schleife fuer drucken
Set oFilter = CreateObject("Scripting.dictionary")
For Each rngG In Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))
oFilter(rngG.Value) = rngG.Value
Next
ar = oFilter.Keys
For i = 0 To UBound(ar)
Cells(1, 1).AutoFilter Field:=5, Criteria1:=ar(i)
ActiveSheet.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
Next
ActiveSheet.ShowAllData
'alles markieren und kopieren
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
' file oeffnen
'Application.Workbooks.Open Filename:=ASN, UpdateLinks:=False
Workbooks("ASNs completed inventorynieuw.xls").Activate
Worksheets("damage waterlekkage completed").Activate
With Worksheets("damage waterlekkage completed")
x = 6800
While .Cells(x, 1) ""
x = x + 1
Wend
Cells(x, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=True
End With
End If
End With
End If
'Datei loeschen wenn andere auf ist...
Workbooks("Tempfile.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Kill "H:\Templates\Tempfile.xls"
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name  "")
On Error GoTo 0
End Function
Gruss
abu
Anzeige
AW: Fehlermeldung: Cannot empty the clip board
29.09.2010 10:36:57
xr8k2
Hallo abu,
verrätst du auch noch, in welcher zeile der Fehler auftritt?
Gruß,
xr8k2
AW: Fehlermeldung: Cannot empty the clip board
29.09.2010 10:48:01
abu
Hallo xr8k2,
bei dieser Zeile habe ich es gesehen:
Workbooks("ASNs completed inventorynieuw.xls").Activate
Das war beim Kollegen.
Ich habe das jetzt auch mal bei mir laufen lassen. Fehler bei der gleichen Zeile aber diesmal dieser:
Subscript out of range.
Problem ist das ich selber nicht damit arbeite. Habs nur fuer einen Kollegen gemacht um ihm ein bissel die Arbeit zu erleichtern.
Gruss
abu
AW: Fehlermeldung: Cannot empty the clip board
29.09.2010 11:37:00
xr8k2
Hallo Abu,
sorry, aber woran der Fehler liegt, kann ich dir beim ersten Überblick über deinen Code nicht sagen ... mir ist nur aufgefallen, dass du die betreffende Datei im Code mehrfach öffnest:
Application.Workbooks.Open Filename:=ASN, UpdateLinks:=False
Zudem muss ich dir sagen enthält der Code auch viele unnötige Selects und Activates. Hierauf sollte man schon allein der Performance wegen verzichten. Auch wird das alles dadurch ziemlich unübersichtlich und schwer zu lesen.
Du solltest det janze diesbezüglich noch mal überarbeiten ... ich könnt mir auch gut vorstellen, das sich in diesem Zusammenhang dein Problem von ganz allein löst.
Gruß,
xr8k2
PS: ich lass trotzdem mal offen ;-)
Anzeige
Fehlermeldung: Subscript out of range
30.09.2010 13:55:57
abu
Hallo xr8k2 und Alle,
habe den Code jetzt mal ueberarbeitet nach meinem koenen.

Workbooks("ASNs completed inventorynieuw.xls").Worksheets("damage waterlekkage completed"). _
Activate
Leider bekomme ich bei dieser Zeile immer eine Fehlermeldung. Da der selbe Code aber vorher schon durchlaeuft (nur mit anderem Tabellennamen) verstehe ich nicht warum dieser Fehler auftritt.
Hat jemand vllt. eine Idee was ich falsch mache?
Hier der komplette Code:

Sub Hans()
Dim strAsn As String                                                'Pfad + Dateiname
Dim oFilter As Object, rngG As Range, ar As Variant, i As Integer   'um filter spaeter  _
setzten zu koennen
Call Datei_speichern
strAsn = "G:\Sites\Beringe2\Kyocera\KME\Warehouse\Returns\ASNs completed inventorynieuw\ _
ASNs completed inventorynieuw.xls"
'*********************************************************************************************** _
If WorksheetExists("WarehouseDHL") Then                    'pruefen ob tabelle besteht
Worksheets("WarehouseDHL").Activate
With Worksheets("WarehouseDHL")
If Cells(2, 1).Value  "" Then                     'pruefen ob daten in Zelle A2  _
stehen
Columns("A:B").Select                           ' 2Spalten einfuegen
Selection.Insert Shift:=xlToRight
Cells(1, 1).Value = "Week"
Cells(1, 2).Value = "DHL / non DHL"
Range("C1").Copy                                'formate von C1 auf A! und B1  _
uebertragen
Range("A1:B1").PasteSpecial Paste:=xlPasteFormats
Cells.Select                                    ' alle raenderformate weg
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Range("A1:L" & leZeile).Select                          'formate fuer drucken  _
vorbereiten
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).ColorIndex = xlAutomatic
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).ColorIndex = xlAutomatic
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).ColorIndex = xlAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Range("A2:A" & leZeile).Value = dt_Kalenderwoche(Date)          'wochennummer  _
in spalte a schreiben
'aufsteigen  _
nach LUID sortieren
Range("A1:L" & leZeile).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select                                                    'formatierung  _
zum drucken
With Selection
Cells.EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 15.5
End With
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Set oFilter = CreateObject("Scripting.dictionary")                 'schleife  _
fuer drucken
For Each rngG In Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))
oFilter(rngG.Value) = rngG.Value
Next
ar = oFilter.Keys
For i = 0 To UBound(ar)
Cells(1, 1).AutoFilter Field:=5, Criteria1:=ar(i)
Call Msg_Box 'ActiveSheet.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
Next
ActiveSheet.ShowAllData
Columns("D:D").Select                                               ' _
formatierungen um ASN datei zu kopieren
Selection.Insert Shift:=xlToRight
Cells(1, 4).Value = "Year"
Range("D2:D" & leZeile).Value = Year(Now)
End If
End With
End If
obiger Code kommt nun noch 2mal fuer 2 andere Tabellen in der Datei

Application.Workbooks.Open Filename:=strAsn, UpdateLinks:=False
Workbooks("Tempfile.xls").Activate
If WorksheetExists("WarehouseDHL") And Worksheets("WarehouseDHL").Cells(2, 1).Value "" Then 'ab hier kopieren in ASN
Worksheets("WarehouseDHL").Activate
Range("A2:L" & leZeile).Copy 'kopieren
Workbooks("ASNs completed inventorynieuw.xls").Worksheets("completed whd").Activate
Cells(leZeile + 1, 1).Select 'erste freie Zelle ermitteln
ActiveSheet.Paste 'kopieren
End If
Workbooks("Tempfile.xls").Activate
If WorksheetExists("RETURNS") And Worksheets("RETURNS").Cells(2, 1).Value "" Then 'ab hier kopieren in ASN
Worksheets("RETURNS").Activate
Range("A2:L" & leZeile).Copy 'kopieren
Workbooks("ASNs completed inventorynieuw.xls").Worksheets("completed returns").Activate
Cells(leZeile + 1, 1).Select 'erste freie Zelle ermitteln
ActiveSheet.Paste 'kopieren
End If
Workbooks("Tempfile.xls").Activate
If WorksheetExists("Warehouse not DHL") And Worksheets("Warehouse not DHL").Cells(2, 1).Value "" Then 'ab hier kopieren in ASN
Worksheets("Warehouse not DHL").Activate
Range("A2:L" & leZeile).Copy 'kopieren
Workbooks("ASNs completed inventorynieuw.xls").Worksheets("damage waterlekkage completed").Activate
Cells(leZeile + 1, 1).Select 'erste freie Zelle ermitteln
ActiveSheet.Paste 'kopieren
End If
ActiveWorkbook.Close SaveChanges:=True 'ASN datei schliessen
Workbooks("Tempfile.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Kill "H:\Templates\Tempfile.xls" 'tempdatei loeschen
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name "")
On Error GoTo 0
End Function
Function leZeile() As Long
leZeile = CLng(Range(ActiveSheet.Range("A:IV").Find(What:="*", _
After:=Range("A65536"), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Address).Row)
End Function

Gruss
abu
Anzeige
AW: Fehlermeldung: Subscript out of range
30.09.2010 14:09:40
Rudi
Hallo,
ohne die vielen Selects und Activates hättest du das Prob nicht ;-)
Trenn mal auf.
Workbooks("ASNs completed inventorynieuw.xls").Activate
Worksheets("damage waterlekkage completed").Activate
Gruß
Rudi
AW: Fehlermeldung: Subscript out of range
30.09.2010 14:17:25
abu
Hallo Rudi,
ich habe doch kaum noch Selects drinne.
Gib mir doch bitte mal ein Tip wie ich die die ich noch drinne habe anders anspreche, dann lern ichs auch mal.
So wie Du es vorschlaegst hatte ich es vorher aber genau die selbe Fehlermeldung tritt bei der Zeile auf.
Wieso laeuft denn die Zeile vorher durch nur bei der letzten nicht, ist das Willkuer?
Gruss
abu
Anzeige
AW: Fehlermeldung: Subscript out of range
30.09.2010 14:32:28
Rudi
Hallo,
Blattname korrekt?
ich würde anstatt lekkage leakage schreiben.
Gruß
Rudi
AW: Fehlermeldung: Subscript out of range
30.09.2010 14:58:46
abu
Hallo Rudi,
alles gecheckt, alles ok. Habe auch umbenannt weil ich dachte der Name ist aus irgendwelchen Gruenden zu lang aber hat auch nichts geholfen.
Was soll ich denn jetzt machen?
Gruss
abu
AW: Fehlermeldung: Subscript out of range
30.09.2010 16:58:54
abu
Hallo Rudi und Alle,
was wuerdest Du denn anders machen, ohne Activate? Koenntest Du mir da vllt. weiterhelfen?
Workbooks("ASNs completed inventorynieuw.xls").Worksheets("damage waterlekkage completed").Activate
Habe das ausprobiert aber auch hier bleibts dann bei der letzten Scheife haengen:
With Worksheets("completed whd")
Cells(leZeile + 1, 1).Select
ActiveSheet.Paste
End With
Was nicht in mein Kopf will ist das es einmal durchlaeuft und beim zweiten mal nicht. Ich dachte ein Computer kennt nur 2 zustaende an und aus, oder richtig und falsch!
Ich verzweifle!
Gruss
abu
Anzeige
Tabelle wird im VBA editor nicht angezeigt
01.10.2010 16:09:46
abu
Hallo Alle,
nach gefuehlten 1000 Codeaenderungen ist mir aufgefallen das bestimmtes Tabellenblatt, welches ich versuche anzusprechen, nicht im VBA-Editor angezeigt wird.
Der umgekehrten Fall, also ein verstecktes Tabellenblatt ist mir bekannt aber dieser Fall nicht.
Ist das normal?
Grus
abu

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige