Öffnen, schließen, und aktivieren

Forumthread: Öffnen, schließen, und aktivieren

10.10.2019 11:50:11

eho

Hallo,
jetzt drehe ich völlig am Rad: In 10 Postigs im Inzernet stehen 10 verschiedene Lösungen.
Was will ich?
Auswahl einer Importdatei mit Hilfe Open Dialoges
Dieses WB hat ein WS "Export"
Jetzt lese ich aus "Export" die letzte beschrieben Zeile aus
Dann wir der Bereich von 2,1 bis letzte beschriebene Zeile, 19 kopiert (.copy)
Nun wird aus dem Zielworkbook das WS "STUNDEN" genommen und die letzte beschrieben Zeile gesucht
Anschl. wird der Zielbereich (den habe ich richtig ermittelt) eingefügt (.paste)
Jetzt soll das QuellWB geschlossen und gelöscht und das WS START aktiviert werden
Ich tappe völlig im Dunkeln, wann ich ein WB öffnen muss, wann schließen und wann welches WS aktivieren?

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Öffnen, schließen, und aktivieren

10.10.2019 13:04:39

Dieter

AW: Öffnen, schließen, und aktivieren

10.10.2019 13:04:39

Dieter

Hallo eho,
das Programm könnte so aussehen. Ggf. musst du deine Angaben noch etwas präzisieren. Ich verwende diejenige Arbeitsmappe, die das VBA-Programm enthält als Zieldatei, kopiere aus Spalte A der Quelle und füge in Spalte A der Zieldatei ein.

Sub DatenÜbernehmen()
Dim dateiQ As String
Dim fd As FileDialog
Dim letzteZeileQ As Long
Dim letzteZeileZ As Long
Dim pfadDateiQ  As String
Dim pfadQ As String
Dim wbQ As Workbook
Dim wbZ As Workbook
Dim wsQ As Worksheet
Dim wsZ As Worksheet
Set wbZ = ThisWorkbook
If Not BlattExistiert(wbZ, "STUNDEN") Then
MsgBox "Blatt ""STUNDEN"" existiert nicht"
Exit Sub
End If
Set wsZ = wbZ.Worksheets("STUNDEN")
pfadQ = wbZ.Path & "\"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = pfadQ
If fd.Show = 0 Then
MsgBox "Benutzerabbruch"
Exit Sub
End If
pfadDateiQ = fd.SelectedItems(1)
dateiQ = Right$(pfadDateiQ, Len(pfadDateiQ) - InStrRev(pfadDateiQ, "\"))
Set wbQ = Workbooks.Open(pfadDateiQ)
If Not BlattExistiert(wbQ, "Export") Then
MsgBox "Blatt ""Export"" existiert nicht"
Exit Sub
End If
Set wsQ = wbQ.Worksheets("Export")
letzteZeileQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row
If letzteZeileQ > 1 Then
wsQ.Cells(2, "A").Resize(letzteZeileQ - 1).Copy
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
wsZ.Cells(letzteZeileZ + 1, "A").PasteSpecial Paste:=xlValues
Application.CutCopyMode = xlCut
End If
wbQ.Close SaveChanges:=True
If Not BlattExistiert(wbZ, "Start") Then
MsgBox "Blatt ""START"" existiert nicht"
Exit Sub
End If
wbZ.Worksheets("START").Activate
End Sub
Function BlattExistiert(Mappe As Workbook, _
BlattName As String) As Boolean
Dim ws As Worksheet
For Each ws In Mappe.Worksheets
If UCase$(BlattName) = UCase$(ws.Name) Then
BlattExistiert = True
Exit Function
End If
Next ws
End Function

https://www.herber.de/bbs/user/132464.xlsm
Viele Grüße
Dieter

Beliebteste Forumthreads (12 Monate)

Öffnen, schließen, und aktivieren

Forumthread: Öffnen, schließen, und aktivieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread