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

Öffnen, schließen, und aktivieren

Ö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
Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige