Office: Daten in einer Liste übernehmen und speichern

Hallo zusammen,
ich habe wieder mal ein Excel-Problem., um das ich euch um Hilfe bitte. Denn beim letzten Mal habt Ihr mir super geholfen.

Jetzt zu meinen Problem: Ich habe acht Arbeitsmappen aus sieben Arbeitsmappen sollen die Daten in die achte Arbeitsmappe übertragen und gespeichert werden.
In der achten Arbeitsmappe müssen dazu ab Zeile 5, 28 Zeilen eingefügt, Arbeitsmappe 1 – 7 geöffnet und jeweils die Daten aus Zelle A1 und dem Bereich E19-G22 kopiert werden, in der achten Arbeitsmappe unter A5-D32 eingefügt und gespeichert werden. Anmerkung, das einfügen der 28 Zeilen ist nötig weil die Liste in Mappe acht nach unten fortlaufen soll. Nach speichern der Arbeitmappe acht, sollen die Daten in den Arbeitsmappen 1-7 nur in den Bereichen E19-G22 gelöscht, gespeichert und wieder geschlossen werden. Arbeitsmappe 1-7 Tragen die Namen Block C – D, E – F, G – H, I – K, L – M, N – O und P – Q. Die Daten stehen in Arbeitsblatt Personal C – D, Personal E – F usw. Arbeitsmappe acht trägt den Namen Urlauswunsch und das Arbeitsblatt heißt genau so.
Der Ordner in dem sich alle Arbeitsmappen befinden heißt Blokdaten.

Dieses hätte ich gerne über ein Makro realisiert, wo ich leider null Ahnung von habe und darum bitte ich um Eure Hilfe.

Ps:
das Makro würde dann jeden Tag ausgeführt, mit Anderen Worten die Liste in Arbeitsmappe 8 wird mit der Zeit sehr lang.

 

Hallo.
oder kann man die Daten auch aus den 7 geschlossenen Arbeitsmappen übernehmen.

 

Hallo ester,

natürlich kann man auf geschlossen Excel-Mappen-Dateien aus einem Excel-Arbeitsblatt heraus zugreifen, zB.:

='I:\EXCEL\Blokdaten\[Block C-D.xls]Personal C-D'!E19

Dabei bedeutet: I:\EXCEL\Blokdaten\ das Laufwerk und den Pfad, Block C-D.xls die Excel-Arbeitsmappe, Personal C-D das Arbeitsblatt und E19 die Zelle im Arbeitsblatt.
Dabei ist auf die einfachen Hochkommas ', auf die eckigen Klammern [ und ] und auf das Ausrufezeichen ! genau zu achten.
Ist eine der Arbeitsmappen zwischenzeitlich geöffnet, so entfällt die Laufwerk- und Pfadangabe (automatisch).

In der UNC-Schreibweise, zB:
='\\ServerXY\EXCEL\Blokdaten\[Block C-D.xls]Personal C-D'!E19

 

Hallo:
Ich habe mal versucht ein Makro aufzunehmen (siehe unten) , jedoch der Nachteil ist das es sehr langsam ist. Da es erst alle Arbeitsmappen öffnet, die Daten kopiert, in eine andere Arbeitsmappe einträgt, die Daten aus den Arbeitsmappen löscht und die Arbeitsmappen speichert. Danach werden die leeren Zeilen gelöscht so dass eine Liste entsteht, diese wird dann wiederum kopiert und in einem anderen Arbeitsblatt eingefügt und sortiert.
Nun meine Frage: Da das Makro sehr langsam ist benötige ich Eure Hilfe um es eventuell schneller zu machen. Z. B. das die Arbeitsmappen nicht extra geöffnet und danach wieder geschlossen werden müssen.


Sub Makro1()
'
' Makro1 Makro
' Makro am 18.04.2009 von ester aufgezeichnet
'

'
Sheets("Urlaubsliste").Select
Range("A6:A33").Select
Selection.EntireRow.Insert
Range("A1").Select
Selection.Copy
Range("A6:A33").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B6").Select
ChDir "C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block C - D.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block E - F.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block G - H.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block I - K.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block L - M.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block N - O.xls"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\ester\Desktop\Blockdaten\Block P - Q.xls"
Windows("Block C - D.xls").Activate
Range("C20:E23").Select
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B10").Select
Windows("Block E - F.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B14").Select
Windows("Block G - H.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B18").Select
Windows("Block I - K.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B22").Select
Windows("Block L - M.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B26").Select
Windows("Block N - O.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B30").Select
Windows("Block P - Q.xls").Activate
Range("C20:E23").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Schichtführer.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C6:D33").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B6:B33").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A6").Select
Windows("Block C - D.xls").Activate
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block E - F.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block G - H.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block I - K.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block L - M.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block N - O.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Block P - Q.xls").Activate
Range("C20:E23").Select
Selection.ClearContents
Range("B3").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Schichtführer.xls").Activate
Range("A6").Select
Dim intRow As Integer, intLastRow As Integer
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 2)) Then
Rows(intRow).Delete
End If
Next intRow
Range("A6:D999").Select
Selection.Copy
Sheets("Urlaubswünsche").Select
Range("A5").Select
ActiveSheet.Paste
Sheets("Urlaubsliste").Select
Range("A6").Select
Sheets("Urlaubswünsche").Select
Range("A5").Select
Selection.AutoFilter
Range("A5:D999").Sort Key1:=Range("C4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A5").Select
ActiveWorkbook.Save

End Sub

 

Darum wirst Du nicht herumkommen, wenn in den Mappen etwas verändert werden soll. Auf geschlossene Mappen kann Excel nur lesend zugreifen, um Zellinhalte auszulesen. Wenn Du aber Zeilen löschen willst, muß die Mappe geöffnet und nach der Änderung auch wieder gespeichert werden.

Das ändert zwar nichts daran, daß der Source des automatisch aufgezeichneten Makros grausam aussieht und um etliches optimiert werden könnte. Aber diese Optimierungen wären in erster Linie kosmetischer Natur und hätten auf die Laufzeit eher vernachlässigbare Wirkung.

Gruß, Michael

 

Hallo ester,

was bereits <miriki> gechrieben hat, trifft 100% zu.

Nachfolgend habe ich den Makrorekorder-Code optimiert und kompakter gemacht (Der Makrorekorder ist zwar ausgezeichnet, wenn man auf die Schnelle wissen will, wie etwas programmiererisch funktioniert. Den Code sollte man dann anschließend optimieren, denn er macht exzessiven Gebrauch vom sehr langsamen Selection-Objekt/Methode).

Da ich mir nicht ganz sicher war hinsichtlich der zu verwendenden Objekte, habe ich einen ausführlichen Kommentar in den Code eingefügt (offensichtliche Abweichungen im Makro zu den Angaben im Posting vom 14.4.2009). Außerdem konnte ich das Makro nur syntaktisch testen - also nicht im Echtbetrieb getestet.

Option Explicit

Sub Makro1()
'
' Makro1 Makro
' Makro am 18.04.2009 von ester aufgezeichnet
'
Dim Pfad$, Mappen As Variant, MapCt%, Blätter As Variant
Dim RgKopie As Range, Wb As Workbook, ShKopie As Worksheet

' Ich nehme an, die Arbeitsmappe "Schichtführer.xls" ist die aktive Arbeitsmappe.
' In diser sind die Arbeitsblätter "Urlaubsliste" und "Urlaubswünsche" enthalten.

'1) Das Arbeitsblatt "Urlaubsliste" wird selektiert und in den Zeilen 6-33 werden leere Zeilen eingefügt
Sheets("Urlaubsliste").Select
Range("A6:A33").EntireRow.Insert

'2) Für die nun leeren Zellen von Blatt "Urlaubsliste" der Arbeitsmappe "Schichtführer.xls":
'2a) Der Wert+Format von Zelle A1 wird in die Zellen A6:A33 kopiert und dort zentriert.
Range("A1").Copy
Set RgKopie = ActiveSheet.Range("A6:A33")
RgKopie.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
BereichFormat RgKopie, xlCenter
Application.CutCopyMode = False

'2b) Ferner wird der leere Bereich B6:D33 des Blattes "Urlaubsliste" befüllt
' sukzessive mit den Werten+Formaten der Zellen C20:E23
' der Blätter "Personal C - D" usw. der geöffneten Arbeitsmappen "Block C - D.xls" usw.
' Die Inhalte der Quellbereiche C20:E23 werden gelöscht und die Quell-Arbeitsmappen gespeichert und geschlossen.
Pfad$ = "C:\Dokumente und Einstellungen\ester\Desktop\Personaldaten\"
Mappen = Array("Block C - D.xls", "Block E - F.xls", "Block G - H.xls", _
"Block I - K.xls", "Block L - M.xls", "Block N - O.xls", "Block P - Q.xls")
Blätter = Array("Personal C - D", "Personal E - F", "Personal G - H", _
"Personal I - K", "Personal L - M", "Personal N - O", "Personal P - Q")
Set ShKopie = ActiveSheet
Set RgKopie = ActiveSheet.Range("B6")
For MapCt% = 0 To UBound(Mappen)
Set Wb = Workbooks.Open(Filename:=Pfad$ & Mappen(MapCt%))
With Wb.Sheets(Blätter(MapCt%))
With .Range("C20:E23")
.Copy
RgKopie.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
.ClearContents
End With
.Range("B3").Select
End With
Wb.Save
Wb.Close
Set RgKopie = RgKopie.Offset(4, 0)
Next MapCt%
'2c) Der Bereich B6:B33 des Blattes "Urlaubsliste" wird horizontal links ausgerichtet,
' während der Bereich C6:D33 horizontal zentriert wird.
Application.CutCopyMode = False
BereichFormat ShKopie.Range("B6:B33"), xlLeft
BereichFormat ShKopie.Range("C6:D33"), xlCenter
Range("A6").Select

'3) Beginnend bei der letzten benutzten Zeile des Blattes "Urlaubsliste"
'3a) wird die letzte Zeile, die Daten enthält, ermittelt
Dim intRow As Integer, intLastRow As Integer
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
'3b) und von dort weg bis zur 1. Zeile des Blattes "Urlaubsliste"
' werden alle Zeilen, die in Spalte B leer sind, entfernt.
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 2)) Then
Rows(intRow).Delete
End If
Next intRow

'4) Der Bereich A6:D999 des Blattes "Urlaubsliste" wird in das Blatt "Urlaubswünsche"
' ab Zelle A5 kopiert und die Zelle A6 von Urlaubsliste wird selektiert.
Range("A6:D999").Copy Destination:=Sheets("Urlaubswünsche").Range("A5")
Range("A6").Select

'5) Das Blatt "Urlaubswünsche" wird selektiert;
'5a) für die Liste, die die Zelle A5 enthält, wird der Autofilter (vermutlich) eingeschaltet
Sheets("Urlaubswünsche").Select
Range("A5").AutoFilter
'5b) Der Bereich A5:D999 des Blattes "Urlaubswünsche" wird aufsteigend nach Spalte C sortiert.
Range("A5:D999").Sort Key1:=Range("C4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A5").Select

'6) Die aktive Arbeitsmappe (Schichtführer.xls) wird gespeichert.
ActiveWorkbook.Save

End Sub

Private Sub BereichFormat(Bereich As Range, HorizAusricht As Variant)
With Bereich
.HorizontalAlignment = HorizAusricht
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub