Herbers Excel-Forum - das Archiv

Aus mehreren Excel dateien 5 Zellen kopieren

Bild

Betrifft: Aus mehreren Excel dateien 5 Zellen kopieren
von: Chris P.

Geschrieben am: 03.01.2007 18:16:35
Hallo,
habe folgendes Problem habe mir hier aus dem Forum ein Makro gesucht und es versucht umzubauen... leider mit wenig erfolg bin ein Absoluter VBA anfänger...
Also mein Ziel ist es Automatisch aus ca. 300 Excel Tabellen 5 Zellen in eine neue Excel Tabelle zu kopieren. Soweit ganz einfach nur habe ich zwei Probleme damit.
1. Bestimmte Zellen werden nicht angenommen. (Inhalt: z.B 5633-54863)
2. Er kopiert auch Formeln mit. Dadurch erscheint in einigen der Kopierten Zellen der Vermerk #BEZUG.
kann jemand über das Makro schauen und mir dabei helfen???

Die Datei https://www.herber.de/bbs/user/39349.xls wurde aus Datenschutzgründen gelöscht

Danke
Chris
Bild

Betrifft: AW: Aus mehreren Excel dateien 5 Zellen kopieren
von: Daniel Eisert

Geschrieben am: 03.01.2007 20:33:25
Hallo
zunächst mal ein paar Tipps, um den code zu verkürzen und lesbarer zu machen:
- statt WORKSHEETS(1) einfach SHEETS(1)
- Wenn sich Objekte häufig im code wiederholen, die WITH-Klammer verwenden.
mit der With-Klammer wird ein Objetk definiert innerhalb der With-Klammer wird dann anstelle es beschiebenen Objekts nur ein Punkt gesetzt.
(Beispiel im Anhang).
Die With-Klammer muß immer mit "End With" abgeschlossen werden.
- jede Zeile, in der zu einer Variable der Wert 0 addiert wird ist überflüssig und kann entfallen (der Variablenwert ändert sich ja nicht.)
Zur ersten Frage
so wie du kopierts, werden die Formeln kopiert, dadurch der Fehler, da die Bezüge innerhalb der Formeln sich jeztt auf die neue Datei beziehen und überhaubp nicht mehr stimmen. du müsstet also anstelle der Formeln die Zellwerte kopieren. das kannst du erreichen, in dem du entweder die Werte aus den Zellen direkt zuweist mit
Range(xxx).value = Range(yyy).value
dabei kann Range(xxx) beliebig groß sein, wenn wenn Range(yyy) nur eine Zelle ist (sonst müssen beide Ranges gleich groß sein), dann wird in jede Zelle aus Range(xxx) der gleiche Wert reingeschrieben. Oder du verwendestst die Copy/Pastespecial-Methode (ist ein Zweizeiler). Das sieht dann so aus:
range(yyy).copy
range(xxx).pastespecial xlpastevalues

die Zellformatierungen werden allerdings nicht mit kopiert.
falls es erforderlich ist, die Zahlenformate mit zu übernehmen, müssten die im ersten Fall mit folgender Zeile kopiert werden:
Range(xxx).numberformat = Range(yyy).numberformat
im zweiten Fall könntest du anstelle des Parameters "xlpastevalues" "xlPasteValuesAndNumberFormats" verwenden. zur zweiten Frage kann ich jeztt leider auch nichts sagen. ich habe beides mal in deine Datei eingefügt, allerdings auskommentiert. Du kannst dann ja das was dir besser gefällt, verwenden zur zweiten Frage kann ich leider nichts sagen. den Sinn der Loop-Schleife verstehe ich nicht ganz. Gruß, Daniel <a href="https://www.herber.de/bbs/user/39350.xls">https://www.herber.de/bbs/user/39350.xls</a>
Bild

Betrifft: AW: Aus mehreren Excel dateien 5 Zellen kopieren
von: fcs

Geschrieben am: 03.01.2007 21:06:09
Hallo Chris,
ich hab den Code jetzt mal so geändert, dass beim Kopieren nur die Formate und Zellwerte kopiert werden. Außerdem hab ich einige überflüssige Zeilen gelöscht (Do .. Loop-Schleife und Zeilenzähler), die hier nicht benötigt werden.
Leider konnte ich den Code nicht testen, hoffe er funktioniert so.
Ob durch die Änderungen auch dein Problem Nr. 1 beseitigt wird weiss ich nicht. Eigentlich sollten diese Zellinhalte beim Kopieren keine Probleme bereiten. Problemfall evtl. verbundenene Zellen.
Gruss
Franz
Sub Telliste()
'Eine Liste aus mehreren erstellen
'By Nike 23.05.01
Dim arrFilenames As Variant
Dim wbkArr As Workbook
Dim wbkBasis As Workbook
Set wbkBasis = ActiveWorkbook
Dim lngBasisZeil As Long
Selection:
' Zu öffnende Dateien erfragen
arrFilenames = Application.GetOpenFilename( _
"Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
"Exceldateien auswählen...", MultiSelect:=True)                ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
If VarType(arrFilenames) = vbBoolean Then
If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
GoTo Selection
Else
Set wbkBasis = Nothing
Exit Sub
End If
End If
Application.ScreenUpdating = False
'Die vom Makro vorgenommenen Tätigkeiten
'bleiben zur Geschwidigkeitssteigerung unsichtbar
lngBasisZeil = 1
For i = 1 To UBound(arrFilenames)   ' Durchläuft die Anzahl der Dateien
'Wenn Datei noch nicht geöffnet
If FileOpenYet(Dir$(arrFilenames(i))) = False Then
'dann öffnen
Workbooks.Open FileName:=arrFilenames(i)
Else
'oder aktivieren
Workbooks(Dir$(arrFilenames(i))).Activate
End If
Set wbkArr = ActiveWorkbook
'hier kommt dann der Code rein, der die ausgewählten Dateien
'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
lngBasisZeil = lngBasisZeil + 1
With wbkBasis.Worksheets(1)
wbkArr.Worksheets(1).Range("E7").Copy
.Cells(lngBasisZeil, 5).PasteSpecial Paste:=xlPasteFormats
.Cells(lngBasisZeil, 5).PasteSpecial Paste:=xlPasteValues
wbkArr.Worksheets(1).Range("C9").Copy
.Cells(lngBasisZeil, 4).PasteSpecial Paste:=xlPasteFormats
.Cells(lngBasisZeil, 4).PasteSpecial Paste:=xlPasteValues
wbkArr.Worksheets(1).Range("B4").Copy
.Cells(lngBasisZeil, 3).PasteSpecial Paste:=xlPasteFormats
.Cells(lngBasisZeil, 3).PasteSpecial Paste:=xlPasteValues
wbkArr.Worksheets(1).Range("I16").Copy
.Cells(lngBasisZeil, 2).PasteSpecial Paste:=xlPasteFormats
.Cells(lngBasisZeil, 2).PasteSpecial Paste:=xlPasteValues
wbkArr.Worksheets(1).Range("E94").Copy
.Cells(lngBasisZeil, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(lngBasisZeil, 1).PasteSpecial Paste:=xlPasteValues
End With
wbkArr.Close savechanges:=False      'Datei schließen
Set wbkArr = Nothing
Next i
Set wbkArr = Nothing
'Ursprüngliche Datei wieder aktivieren
wbkBasis.Activate
Set wbkBasis = Nothing   'Die Variable zurücksetzen
'und den Monitor aktivieren
Application.ScreenUpdating = True
End Sub
Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).Name
FileOpenYet = True
Exit Function
Nonexistent:
FileOpenYet = False
End Function

Bild

Betrifft: AW: Aus mehreren Excel dateien 5 Zellen kopieren
von: Chris P.
Geschrieben am: 05.01.2007 23:54:29
Vielen Dank
habt mir sehr geholfen.
Kennt ihr ein gutes buch für einsteiger zum Thema VBA?
Grüße
Chris
 Bild
Excel-Beispiele zum Thema "Aus mehreren Excel dateien 5 Zellen kopieren"
Druck aus mehreren Tabellenblättern auf eine Druckseite Daten von mehreren Blättern auf ein Druckblatt
Werte in mehreren Spalten sortieren Den selben Bereichsnamen in mehreren Tabellenblättern
Tabelle nach mehreren Kriterien summieren Auswahl von Zellen in mehreren Zeilen verhinden
Wert von einer Zelle zur anderen in mehreren Tabellen übernehmen Benannte Bereich aus mehreren Arbeitsmappen importieren
Filtern über VBA nach mehreren Kriterien Kosten nach mehreren Kriterien erfassen