On Error

Option Explicit Sub Transponieren() Dim wkb1 As Workbook, wkb2 As Workbook Set wkb1 = Workbooks("Schichtvorlagen.xls") Set wkb2 = Workbooks("Sortierer.xls") Application.ScreenUpdating = False wkb1.Sheets("Schichtplan Sortierer").Range("C6:K36").Copy wkb2.Sheets("Jänner").Range("C500").PasteSpecial Paste:=xlPasteValues, Transpose:=True Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub Transponieren() Dim WsDatei As Workbook, BoVor As Boolean Dim wkb1 As Workbook, wkb2 As Workbook For Each WsDatei In Workbooks If WsDatei.Name = "Schichtvorlagen.xls" Then BoVor = True End If Next If BoVor Then For Each WsDatei In Workbooks If WsDatei.Name = "Sortierer.xls" Then BoVor = True End If Next If BoVor Then Set wkb1 = Workbooks("Schichtvorlagen.xls") Set wkb2 = Workbooks() Application.ScreenUpdating = False wkb1.Sheets("Schichtplan Sortierer").Range("C6:K36").Copy wkb2.Sheets("Jänner").Range("C500").PasteSpecial Paste:=xlPasteValues, Transpose:= _ True Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "Sortierer.xls nicht offen" End If Else MsgBox "Schichtvorlagen.xls nicht offen" End If End Sub

Option Explicit Sub Transponieren() Dim WsDatei As Workbook, BoVor As Boolean Dim wkb1 As Workbook, wkb2 As Workbook For Each WsDatei In Workbooks If WsDatei.Name = "Schichtvorlagen.xls" Then BoVor = True End If Next If BoVor Then BoVor = False For Each WsDatei In Workbooks If WsDatei.Name = "Sortierer.xls" Then BoVor = True End If Next If BoVor Then Set wkb1 = Workbooks("Schichtvorlagen.xls") Set wkb2 = Workbooks("Sortierer.xls") Application.ScreenUpdating = False wkb1.Sheets("Schichtplan Sortierer").Range("C6:K36").Copy wkb2.Sheets("Jänner").Range("C500").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "Sortierer.xls nicht offen" End If Else MsgBox "Schichtvorlagen.xls nicht offen" End If End Sub

Sub Transponieren() Dim wkb1 As Workbook, wkb2 As Workbook If Not Check_WB("Schichtvorlagen.xls") Then MsgBox "bla bla" Exit Sub End If End Sub Function Check_WB(strName$) As Boolean On Error Resume Next Check_WB = Workbooks(strName).Name "" End Function

Hallo,
dann stimmt was anderes nicht, evtl. die Tabelle?
Versuch mal diesen Code.

Sub Transponieren()
Dim wkb1 As Workbook, wkb2 As Workbook

If Not Check_WB("Schichtvorlagen.xls") Then
    MsgBox "Datei Schichtvorlagen.xls ist nicht offen"
    Exit Sub
ElseIf Not Check_Tab(Workbooks("Schichtvorlagen.xls"), "Schichtplan Schrumpfer") Then
    MsgBox "Die Tabelle Schichtplan Schrumpfer gibt es nicht"
    Exit Sub
End If

If Not Check_WB("Sortierer.xls") Then
    MsgBox "Datei Sortierer.xls ist nicht offen"
    Exit Sub
ElseIf Not Check_Tab(Workbooks("Sortierer.xls"), "Jänner") Then
    MsgBox "Die Tabelle Jänner gibt es nicht"
    Exit Sub
End If

Set wkb1 = Workbooks("Schichtvorlagen.xls")
Set wkb2 = Workbooks("Sortierer.xls")

Application.ScreenUpdating = False

wkb1.Sheets("Schichtplan Sortierer").Range("C6:K36").Copy
wkb2.Sheets("Jänner").Range("C500").PasteSpecial Paste:=xlPasteValues, Transpose:=True

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function Check_WB(strName$) As Boolean
On Error Resume Next
Check_WB = Workbooks(strName).Name <> ""
End Function

Function Check_Tab(oWB As Workbook, strTabName$) As Boolean
On Error Resume Next
Check_Tab = oWB.Sheets(strTabName).Index <> 0
End Function

Gruß Tino

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread