Werte einfügen funktioniert nicht mehr
08.12.2020 13:12:45
Enrico
ich habe folgendes Problem und würde mich freuen, wenn mir jemand helfen kann.
Ich habe eine Tabelle aus der ich eine weitere Tabelle öffne, in diese dann etwas rein kopiere und ein Makro starte und sie unter einem anderen Namen woanders abspeichere. Das hat auch alles gut geklappt, bis auf den Fall, wenn die Makros in der zu öffnenden Tabelle nicht aktiviert waren. Darum habe mit Set UplXl = CreateObject("Excel.Application") gearbeitet um beim öffnen die Makros aktivieren zu können. Das einzige Problem ist nun, das beim einfügen des Inhalts nicht mehr die Werte eingefügt werden und auch die beiden Ranges nicht. Ich kopiere eine Zeile mit Überschriften (Range1) und ein paar Zeilen weiter unten die Daten dazu (Range2) mit Union. Beim Einfügen werden alle Formate übernommen und alles als ein großer Bereich eingefügt, auch die Zeilen die zwischen Range 1&2 liegen.
Bonusfrage: muss ich "UplXl" vorallen "Application" schreiben oder nur vor "application.run"?
Sub übertragen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Pfad, PfadNeu, UplVorlage, UplNeu, NameSDB, NameSDBkurz As String
Dim SDBQS, UPLQS As Worksheet
Dim UplXl As Object
NameSDB = ThisWorkbook.Name
NameSDBkurz = Left(NameSDB, Len(NameSDB) - 5)
Pfad = "xxxx\"
UplVorlage = "upload.xlsb"
PfadNeu = "yyyy\"
UplNeu = "UPL_" & NameSDBkurz & ".xlsb"
Set UplXl = CreateObject("Excel.Application")
With UplXl
.Visible = True
With .Workbooks.Open(Pfad & UplVorlage)
.RunAutoMacros 1
End With
End With
Set SDBQS = ThisWorkbook.Worksheets("QS-Info")
Set UPLQS = UplXl.Workbooks(UplVorlage).Worksheets("QS-Daten")
With UPLQS
.Range("B2") = SDBQS.Range("B1")
.Range("B3") = SDBQS.Range("B2")
.Range("B4") = SDBQS.Range("B3")
.Range("B5") = SDBQS.Range("B4")
.Range("B6") = SDBQS.Range("B5")
.Range("B10") = SDBQS.Range("B6")
.Range("B11") = SDBQS.Range("B7")
.Range("B8") = SDBQS.Range("B8")
.Range("B9") = SDBQS.Range("B9")
End With
ThisWorkbook.Worksheets("TabelleMitDaten").Activate
Call kopieren
With UplXl.Workbooks(UplVorlage)
.Activate
.Worksheets("ZielTabelle").Range("D2").PasteSpecial Paste:=xlPasteValues 'Vielen Dank im Voraus.
Mfg Enrico
Anzeige