Hallo,
ich würde gerne folgendes Makro auf einen Button legen:
Situation:
1. Ich öffne Datei1
2. In der Datei1 gibt es im Tabellenblatt 4 bestimmte Felder (A4 bis Zx) x variiert (habe es immer von A4 bis Z4 markiert und über Strg-Umschalt-PfeilnachUnten) gemacht.
3. Ich lösche diese Zellen (einfach löschen funktioniert nicht, da Bilder an Zellen hängen, die durch die normale Entf-Taste nicht mit erfasst werden; auch über alle Objekte auswählen funktioniert es nicht, weil sonst alle Makro-Buttons mit erfasst werden)
4. Nachdem ich die Felder/Zellen gelöscht habe, öffne ich eine neue Datei (Beispielname: Datei2); Der Name ist immer identisch, nur die Daten werden monatlich aus einem Programm im selben Format exportiert.
5. In Datei 2 markiere ich alle Zellen von A2 bis Zx (x variiert hier ebenfalls, je nachdem ob die Liste länger wird)
6. Ich kopiere diese Zellen (Achtung in B2 bis Bx und N2 bis Nx befinden sich Bilder/GIFs; außerdem sind viele Zellen verlinkt). Dies bitte beim kopieren Berücksichtigen; da offenbar PasteSpecial nicht für Objekte funktioniert.
7. Und füge die kopierte Inhalte wieder in Datei 1 Tabellenblatt 4 in A4 rein, damit das Format das selbe bleibt.
8. Anschließend formatiere ich die neu importierten Daten mit: Rahmen um die Zelle + Texte nach links verschieben
9. Ich schließe Datei2
10. Fertig
Ich habe schon einiges probiert: Das oben beschriebene z.B. über die Aufnahme-Funktion. Das klappte ziemlich gut. Problem war, dass ich danach die Datei nicht mehr speichern konnte, weil er meinte, diese sei beschädigt.
Dann habe ich es noch über folgenden VBA Code probiert (Kollege hat das erstellt, Originaldatei kann ich leider nicht bereitstellen, da wie ihr im Code seht es sich um sensible Daten handelt; aber oben steht eigentlich das nötigste; Das Problem ist, dass die Makros beide gut funktionieren, aber beim Speichern tritt immer ein kritischer Fehler auf und die Datei is futsch):
Sub import_patents7()
Dim wbAkt As Workbook, wbQuell As Workbook
Dim wsAkt As Worksheet, wsQuell As Worksheet
Dim rngDel As Range, rngQuell As Range, rngZiel As Range
'Finde den Bereich, wo die neuen Daten stehen
Set wbQuell = Workbooks.Open(Filename:="G:\Innovation\_Management_Docs\export_patents.xlsx")
Set wsQuell = wbQuell.Worksheets(1)
With wsQuell
Set rngQuell = .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 25))
Debug.Print "Quelle: " & wbQuell.Name & "." & wsQuell.Name & "." & rngQuell.Address
End With
'Finde den Bereich, wo die alten Daten stehen
Set wbAkt = ThisWorkbook
Set wsAkt = wbAkt.ActiveSheet
With wsAkt
Set rngDel = .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp)).EntireRow
Debug.Print "Ziel: " & wbAkt.Name & "." & wsAkt.Name & "." & rngDel.Address
End With
'Kopiere die Daten
rngDel.Value = ""
rngQuell.Copy
rngDel(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
With wsAkt
Set rngZiel = .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp)).EntireRow
End With
Debug.Print rngZiel.Parent.Parent.Name & "." & rngZiel.Parent.Name & "." & rngZiel.Address
'Formatierung anpassen
With rngZiel
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C2").Select
'Quelle schließen
wbQuell.Close savechanges:=False
'aufräumen
Set rngDel = Nothing
Set rngZiel = Nothing
Set wsAkt = Nothing
Set wbAkt = Nothing
Set rngQuell = Nothing
Set wsQuell = Nothing
Set wbQuell = Nothing
End Sub
Wäre froh, wenn wer helfen könnte!