Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
264to268
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
264to268
264to268
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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.



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
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige