Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Diagramm

Forumthread: Diagramm

Diagramm
03.06.2003 14:17:09
Erich Schmidt
Hallo und guten Tag...
Wer kann mir helfen. Jeden Tag wird eine Datei angelegt mit dem Datum als Filename. Aus dieser Datei sollen die Ergebnisse aus 6 Zellen (z.B. F96:K96)in eine neue Datei geschrieben werden.
Die Tabelle soll pro Tag sechs Spalten haben. Aus dieser Tabelle wird dann ein Diagramm auf einer seperaten Tabelle.
Im voraus vielen Dank.



Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Diagramm
03.06.2003 15:57:57
Dan

Hallo Erich,
mit diesem makro kann man mehrere Sheets gleichzeitig offnen und ein bestimmtes range in ein neues workbook kopieren. Der range habe ich auf verschiedene sechs Zellen aufgestellt, aber man kann den range andern (siehe im code). Mfg. Dan.

Option Explicit
Option Base 1

Public Sub DatenKopieren()
Dim myFiles As Variant, myFile As Variant, rDaten As Range
Dim iRow As Integer, iCol As Integer, rCell As Range
Dim wrb As Workbook, wks As Worksheet, wZielDatei As Workbook

On Error GoTo hErr

Set wZielDatei = Application.Workbooks.Add
myFiles = Application.GetOpenFilename("MS Excel Files (*.xls),*.xls", , "Dateien Offnen", , True)
iRow = 0
iCol = 0

If IsArray(myFiles) Then
For Each myFile In myFiles

Set wrb = Application.Workbooks.Open(myFile)

For Each wks In wrb.Worksheets

'den kopierten Range kann man hier andern
Set rDaten = Application.Union(wks.Range("A1:C1"), wks.Range("A3:C3"))

iRow = iRow + 1
iCol = 1
With wZielDatei.ActiveSheet
For Each rCell In rDaten.Cells
.Cells(iRow, iCol).Value = CStr(rCell.Value)
iCol = iCol + 1
Next rCell
.Cells(iRow, iCol).Value = CStr(wrb.Name) & " | " & wks.Name
End With
Next wks

wrb.Close

Next myFile
End If

Exit Sub

hErr:
MsgBox "Runtime Fehler, desc. : " & Err.Description
End
End Sub


Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige