Tabellenblatt unter VB ansprechen

Sub kopieren() Dim xlwks As Excel.Application Set xlwks = Excel.Application With xlwks .Worksheets(1).Select .Worksheets(1).Copy Before:=.Workbooks("Kim_1.xls").Worksheets(1) Application.Run "Kim_1.xls!transpons" .Worksheets(1).Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = False Application.ScreenUpdating = False .Worksheets(3).Select End With End Sub

Sub transpons() Dim intRow As Integer Dim x As String Range("A1:HQ100").Select Selection.Copy Sheets("Tabelle1").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Rows("2:2").Select ' Zeile 2 gelöscht Application.CutCopyMode = False Selection.Delete Shift:=xlUp Range("A1").Select Application.DisplayAlerts = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub kopieren() Dim xlApp As Object Dim xlWbk1 As Object, xlWbk2 As Object On Error GoTo Err_exit Set xlApp = CreateObject(Class:="Excel.Application") Set xlWbk1 = xlApp.Worksheets(1) Set xlWbk2 = xlApp.Workbooks.Open("I:\Excel\Kerstin\Kim\Kim_1.xls") xlApp.Worksheets(1).Select xlApp.Worksheets(1).Copy Before:=Workbooks("Kim_1.xls").Worksheets(1) Application.Run "Kim_1.xls!transpons" xlApp.Worksheets(1).Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = False Application.ScreenUpdating = False xlApp.Worksheets(3).Select xlApp.DisplayAlerts = False xlWbk1.Worksheets(1).Delete xlApp.DisplayAlerts = True xlWbk1.Close savechanges:=True xlWbk2.Close savechanges:=True Set xlApp = Nothing Set xlWbk1 = Nothing Set xlWbk2 = Nothing Err_exit: MsgBox "Fehler: " & CStr(Err.Number) & vbLf & Err.Description, 16, "Fehler" If Not xlApp Is Nothing Then xlApp.Visible = True End Sub

Hallo Frank,
du hast das Prinzip noch nicht begriffen. Dein Code:
***************************************************************************
Set xlWbk1 = xlApp.Worksheets(1)
Ich habe doch geschrieben, wenn du eine Application anlegst, dann ist die leer. Ohne Mappe ohne Tabellen. Wenn du eine neue Mappe anlegen willst, dann so:
Set xlWbk1 = xlApp.Workbooks.add
***************************************************************************
xlApp.Worksheets(1).Select
Ich habe doch geschrieben, das Select und Activate völlig unnötig sind.
***************************************************************************
xlApp.Worksheets(1).Copy Before:=Workbooks("Kim_1.xls").Worksheets(1)
Wozu machst du erst eine Objektvariable um das 1. Das aktive Tabellenblatt welches leer ist mit einer VBA - Anweisung zu kopieren?
Wenn dann so:
xlWbk1.worksheets(1).copy Before:=xlWbk2.worksheets(1)
***************************************************************************
Application.Run "Kim_1.xls!transpons"
Glaubst du wirklich, VB weiß was Application ist? Die Application die du angelegt hast heißt xlApp. Also:
xlApp.Run "Kim_1.xls!transpons"
***************************************************************************
xlApp.Worksheets(1).Select
Und schon wieder ein Select
***************************************************************************
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Lauter VBA - Anweisungen !!!
***************************************************************************
Fassen wir mal die zwei Anweisungen zusammen.
xlApp.Worksheets(1).Select
ActiveWindow.SelectedSheets.Delete
Das kannst du doch ganz einfach so schreiben:
xlWbk1.worksheets(1).delete
***************************************************************************
xlApp.Worksheets(3).Select
Sage ich jetzt nichts, denn es kann ja sein, dass du beim Anzeigen der Mappe die 3. Tabelle vorgewählt haben willst.
Aber die Application ist immer noch unsichtbar, da die Visible - Eigenschaft auf False steht. Wenn du die Mappe sehen willst, dann:
xlApp.visible=True
Es ist auch völlig unklar, was in dem Makro eigentlich passieren soll. Ich habe mein Beispiel an deinen Code angelehnt, aber verstanden habe ich es nicht.
Gruß
Nepumuk

Hallo Frank,
das ist doch ganz einfach:

Option Explicit
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" ( _
    ByVal dwFlags As Long, _
    ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" ( _
    ByVal hSnapshot As Long, _
    ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" ( _
    ByVal hSnapshot As Long, _
    ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long) As Long
Private Const TH32CS_SNAPPROCESS = &H2
Private Const MAX_PATH = &H104
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Sub Main()
    Dim xlApp As Object, xlWbk As Object, xlWorksheet As Object
    On Error GoTo Err_exit
    If fncExcelRun Then
        Set xlApp = GetObject(, "excel.application")
        Set xlWorksheet = xlApp.activesheet
        xlApp.screenupdating = False
        Set xlWbk = xlApp.workbooks.open("I:\Excel\Kerstin\Kim\Kim_1.xls")
        xlWorksheet.Copy before:=xlWbk.worksheets(1)
        xlApp.Run "Kim_1.xls!transpons"
        xlApp.displayalerts = False
        xlWbk.worksheets(1).Delete
        xlWbk.Close savechanges:=True
        xlApp.displayalerts = True
        xlApp.screenupdating = True
        Set xlApp = Nothing
        Set xlWorksheet = Nothing
        Set xlWbk = Nothing
    Else
        MsgBox "Excel ist nicht gestartet.", 16, "Programmabbruch"
    End If
    Exit Sub
Err_exit:
    MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & Err.Description, _
    16, "Fehlermeldung"
End Sub
Private Function fncExcelRun() As Boolean
    Dim Snap As Long, Process As PROCESSENTRY32, Result As Long
    Snap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If Snap <> -1 Then
        Process.dwSize = Len(Process)
        Result = Process32First(Snap, Process)
        Do Until Result = 0
            If InStr(1, UCase$(Process.szExeFile), "EXCEL.EXE") Then
                fncExcelRun = True
                Exit Function
            End If
            Result = Process32Next(Snap, Process)
        Loop
    End If
    CloseHandle Snap
End Function

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Tabellenblatt unter VB ansprechen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

74 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblatt unter VB ansprechen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

74 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread