Collapse column

Autor Thema: VBA: Lösche Felder, öffne Datei, kopiere Felder, füge in gelöschten Bereich ein  (Gelesen 981 mal)

Offline Mynority

  • Newbie
  • *
  • Beiträge: 5
    • Profil anzeigen
  • Office-KnowHow: Fortgeschritten
  • VBA-KnowHow- : Ohne
  • Version [Office] : Office 2010
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!
« Letzte Änderung: Juni 09, 2015, 14:13:19 Nachmittag von Mynority »

Keine Lösung gefunden? Du kannst Dich gerne an unser erfahrenes Experten-Team wenden und Dein Anliegen in Auftrag geben.
>>> Schnell und einfach ein unverbindliches Angebot anfordern. Per E-Mail an anfrage@excel-inside.de oder per Online-Formular
<<<

!!! Wichtige Information
!!! Dieses Forum steht aus technischen Gründen ab dem 11. September 2019 nur noch im Lesemodus zur Verfügung.
Das NEUE Office-Fragen-Forum kannst du aber unter der gewohnten Domain https://office-fragen.de wie gewohnt nutzen.

- Wir freuen uns auf deinen Besuch im neuen Forum.

Offline Mynority

  • Newbie
  • *
  • Beiträge: 5
    • Profil anzeigen
  • Office-KnowHow: Fortgeschritten
  • VBA-KnowHow- : Ohne
  • Version [Office] : Office 2010
Antw: VBA: Lösche Felder, öffne Datei, kopiere Felder, füge in gelöschten
« Antwort #1 am: Juni 09, 2015, 16:33:08 Nachmittag »
Also, offenbar bricht alles zusammen, wenn ich versuche die Objekte mit zu kopieren. Wenn ich die Bilder und verlinkten pdf-objekte nicht mitnehme, dann funktioniert alles ohne komische Speicherfehlermeldungen.

Hat jemand so ein Problem schonmal gehabt?

Gibt es eine Möglichkeit z.B. aus Spalte B Zeile 2 bis x die Objekte separat (einzeln?) über eine Schleife zu kopieren?

Vielleicht gibt es dann keinen Fehler?

Also erst alle Zelleninhalte samt Links, und nachträglich die Bilder. aus B2 bis Bx nach B4 bis Bx+2 in die Datei1?

Wenn du dich noch intensiver mit Excel beschäftigen möchtest, dann empfiehlt sich ein Online-Kurs,
in dem du sehr viel über Excel erfährst und das gelernte umgehend in der Praxis anwenden kannst.