Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Per VBA eine übergr. Datei Zelle für Zelle kopiere

Per VBA eine übergr. Datei Zelle für Zelle kopiere
30.10.2014 20:00:03
Andreas Franz

Hi zusammen,
ich habe eine Datei die sich mit der Zeit aufgebläht hat und von Mal zu Mal größer wird. Daher war meine Idee diese Datei Zelle für Zelle nur den reinen Text per Makro zu kopieren. Danach noch folgende Punkte:
- Register Farbe
- Spaltenbreite
- spaltenhöhe
Das habe ich mir bis jetzt zusammenkopiert ... funktioniert aber nicht wirklich zufriedenstellend bzw. das mit der Spaltenbreite und Höhe der Reihen gar nicht. Hat jemand so was? Bzw. wie hoch seht Ihr die Chance das die größe der Datei sich verbessert? Toll wär wenn jemand schon mal einen ähnliche Idee hatte.
LG
Andreas

Sub im_Hintergrund_bestehende_mappe_oeffnen()
'falls ein Fehler auftritt gehe zur Fehlerbehandlung
On Error GoTo errhandler
Dim objAppExcel As Object
Dim objWb As Object
Dim objSH As Object
Dim AktuelleMappe As Workbook
Dim rngArr, rngSource, rngTarget
Dim I As Integer
Dim WS_Countdest, WS_Countsource As Integer
Dim iCounter As Variant
Set AktuelleMappe = ActiveWorkbook
Set objAppExcel = CreateObject("Excel.Application")
Set objWb = objAppExcel.Workbooks.Open("C:\Users\grisu20\Desktop\Einteilung\Einteilung v. 1.6.  _
_
xlsm")
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Countsource = objWb.Worksheets.Count
WS_Countdest = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Countsource
Set objSH = objWb.Sheets(I)
Sheets.Add
ActiveSheet.Name = objWb.Sheets(I).Name
With objSH
rngArr = .Range(.Cells(1, 1), varLast(3, objWb.Sheets(I)))
Set rngSource = .Range(.Cells(1, 1), varLast(3, objWb.Sheets(I)))
End With
AktuelleMappe.Sheets(I).Range(Cells(1, 1), varLast(3, objWb.Sheets(I))).Value = rngArr
Set rngTarget = AktuelleMappe.Sheets(I).Range(Cells(1, 1), varLast(3, objWb.Sheets(I)))
For iCounter = 1 To AktuelleMappe.rngSource.Rows.Count
rngTarget.Rows(iCounter).RowHeight = _
rngSource.Rows(iCounter).RowHeight
Next iCounter
For iCounter = 1 To rngSource.Columns.Count
rngTarget.Columns(iCounter).ColumnWidth = _
rngSource.Columns(iCounter).ColumnWidth
Next iCounter
Next
objWb.Close savechanges:=False
objAppExcel.Quit
Set objSH = Nothing
Set objWb = Nothing
Set objAppExcel = Nothing
Exit Sub
errhandler:
MsgBox "Fehlernr:" & Err.Number & " " & Err.Description
objWb.Close savechanges:=False
objAppExcel.Quit
Set objSH = Nothing
Set objWb = Nothing
Set objAppExcel = Nothing
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Dateigröße
31.10.2014 07:46:31
Hajo_Zi
Hallo Andreas,
Du hast schon geprüft ob Strg+Ende mit dem Ende der Tabelle übereinstimmt? Eine Zeile mehr löschen und speichern.
Rahmen kost viel Platz, wenn jede Zelle einzeln der rahmen zugewiesen wurde.

AW: Dateigröße
31.10.2014 17:57:01
Andreas Franz
Hi Hajo,
ja genau das ist das Problem. Die Datei wird werktäglich von vielen Usern genutzt. Und es war bis dato jedem möglich zu machen was er möchte. Deshalb würde ich die Datei gerne neu aufbauen. Da Sie jedoch sehr viele Formeln enthält wollte ich das nicht per Hand machen. Und das komplette Blatte kopieren und nur die Werte einfügen hat leider auch nicht zu einer verringerung geführt. Im gegenteil, dadurch wurde sie noch ein bisschen größer.
Daher die Idee das per VBA zu lösen und Zelle für Zelle nur die Formeln und Texte zu setzen.
Den Rest wie Bedingte Formatierungen und restrictionen würde ich danach neu setzten.
Hat jemand zufällig so einen Code bzw. kann mir helfen die Spalten breite und Reihen höhe zu laufen zu bringen.
LG
Andreas

Anzeige
AW: Dateigröße
31.10.2014 17:58:24
Hajo_Zi
Gurt mein Vorschlag hat Dir also nicht gefallen. Ich bin dann raus.
Gruß Hajo

330 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige