Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
832to836
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
832to836
832to836
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Aus mehreren Excel dateien 5 Zellen kopieren

Aus mehreren Excel dateien 5 Zellen kopieren
03.01.2007 18:16:35
Chris
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

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

Betreff
Datum
Anwender
Anzeige
AW: Aus mehreren Excel dateien 5 Zellen kopieren
03.01.2007 20:33:25
Daniel
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>
Anzeige
AW: Aus mehreren Excel dateien 5 Zellen kopieren
03.01.2007 21:06:09
fcs
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

Anzeige
AW: Aus mehreren Excel dateien 5 Zellen kopieren
05.01.2007 23:54:29
Chris
Vielen Dank
habt mir sehr geholfen.
Kennt ihr ein gutes buch für einsteiger zum Thema VBA?
Grüße
Chris

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige