Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
876to880
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
876to880
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten automatisch übernehmen

Daten automatisch übernehmen
14.06.2007 12:10:00
Enjoy82
Hallo!
Ich habe einen Ordner "Aktuell" in den täglich .xls Dateien abgespeichert. Es handelt sich um Problemblätter mit demselben Layout.
Außerdem habe ich ein Gesamtlistenfile erstellt.
Ich möchte nun per Makro folgendes lösen:
[Makro wird im Gesamtlistenfile gestartet]
Öffnet das erste xls File im "Aktuell" Ordner, kopiert die Zelle A10 und B10 und fügt sie im Gesamtfile unter A1 bzw A2 ein. Danach wird das nächste File im "Aktuell" Ordner geöffnet, A10 und B10 kopiert und in B1 bzw. B2 eingetragen (im Gesamtfile soll immer in der ersten freien Zelle eingefügt werden; wenn zb. in A1 bis A20 bzw. B1 bis B20 schon daten stehen, soll A21 bzw B21 verwendet werden).
Danke im Voraus für Eure Unterstützung.
LG Robert

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten automatisch übernehmen
14.06.2007 16:34:00
nighty
hi robert :-)
wie eine zelle oder ein bereich kopiert wird,wird im code aufgefuehrt ein wenig
gruss nighty
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
Rem groesse des array des zu kopierenden bereiches anpassen,deklarierung anpassen
ReDim Bereich1(3, 1) As Variant
With Application.FileSearch
.NewSearch
Rem Pfad anpassen
.LookIn = "D:\Temp\"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Rem sheetname anpassen oder ueber index
zeile = ThisWorkbook.Sheets("AngebotAuflistung").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rem erste beispiel,kopiert eine zelle,sheetname anpassen oder ueber index
ThisWorkbook.Sheets("AngebotAuflistung").Range("A" & zeile) = Workbooks(DateiName).Sheets("Angebot").Range("A10")
Rem die naechsten drei zeilen fuer das 2 beispiel,das einen bereich kopiert,beachte bei der deklarierung des array am anfang auch auf dessen groesse
Rem sheetname anpassen oder ueber index
Workbooks(DateiName).Sheets("Angebot").Select
Bereich1() = Range("C1:E1")
Rem sheetname anpassen oder ueber index
ThisWorkbook.Sheets("AngebotAuflistung").Range("C" & zeile & ":E" & zeile) = Bereich1()
Workbooks(DateiName).Close
End If
Next Dateien
End If
End With
Call EventsOn
End Sub



Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub



Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige