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

Bereich von Mappe2 zu Mappe1 kopieren

Bereich von Mappe2 zu Mappe1 kopieren
10.10.2007 19:46:04
Mappe2
Hallo Gemeinde,
ich hab da ein Problem, zu dessen Lösung ich einfach nichts Verwertbares finden kann.
Ich habe eine Mappe1 in der Auswertungen gemacht werden sollen. Täglich sollen neue Daten aus einer Mappe2-Tabelle"Details" in Tabelle1 der Mappe1 importiert werden (einfach kompletten Bereich ohne Überschriften an den letzten Eintrag in Tabelle1 anfügen). Dazu soll aber geprüft werden, welche Dateien bereits importiert wurden. Deshalb lasse ich per Makro (DateienAuflisten) die bestehenden Dateien im Verzeichnis in die Spalte H Mappe1-Tabelle2 schreiben. Wie kann ich nun den Abgleich machen, um zu sehen, welche Dateien neu in das Verzeichnis gekommen sind, diese auswählen und "importieren" lassen?
Desweiteren besteht noch das Problem, dass in den Spalten neben dem Datenbereich Formeln stehen, die natürlich nach dem "Import" neben den eingefügten Daten nach unten aktualisiert werden sollen ....

Sub DateienAuflisten()
Dim i As Long
Const Pfad = "C:\Exceldateien\"
On Error GoTo fehler
ChDir Pfad
Range("H1").Select
With Application.FileSearch
.NewSearch
.LookIn = Pfad
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
ActiveCell.Value = .FoundFiles(i)
'ActiveCell.Hyperlinks.Add ActiveCell, ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Next i
End With
Exit Sub
fehler:
MsgBox "Es gibt kein Verzeichnis mit dem Namen " & Pfad
End Sub


Das Import-Makro (noch im Teststadium) funktioniert grundsätzlich, aber leider halt nur innerhalb einer Mappe ...


Sub Import_Bereich()
Dim rng As Range
Dim rng2 As Range
Dim lRow As Integer
Set rng = ThisWorkbook.Worksheets("Tabelle1").Range("A1").CurrentRegion
Set rng2 = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
rng2.Copy
'letzte Zeile
lRow = Tabelle1.UsedRange.Rows.Count
Cells(rng1 + 1, 1).Select
Selection.PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub


Kann mir irgendjemand auf die Sprünge helfen ... packe ich das zu kompliziert an?
Danke schon mal im Voraus
Gruß
Vinz

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich von Mappe2 zu Mappe1 kopieren
10.10.2007 21:43:02
Mappe2
hallo Vinz,
Das Script geht davon aus, dass in der Datei, in der die Daten gesammelt werden ein Tabellenblatt mit dem Namen "Übersicht" und ein Tabellenblatt mit dem Namen "Import-Liste" existiert.
Die Daten werden jeweils aus der Tabelle "Details" importiert.
Gib mir Bescheid, wie du damit zurecht kommst...
Gruß
Christian

Option Explicit
Sub GetDataFromFiles()
Dim wkb As Workbook
Dim wksList As Worksheet, wksAll As Worksheet
Dim i As Long, lngList As Long, lngAll As Long, lngData As Long
Dim strArrFile() As String, strFile As String, strMsg As String
Dim blnFnd As Boolean
Const strPfad As String = "C:\Exceldateien\"
If Dir(strPfad) = "" Then
MsgBox "Es gibt kein Verzeichnis mit dem Namen " & strPfad, 16
End
End If
On Error GoTo ErrorHandler
ChDrive (Left(strPfad, 1))
ChDir strPfad
Set wksList = ThisWorkbook.Sheets("Import-Liste")
Set wksAll = ThisWorkbook.Sheets("Übersicht")
lngList = wksList.Cells(Rows.Count, 1).End(xlUp).Row
strMsg = "Datenimport:" & vbLf
ReDim strArrFile(lngList - 1)
For i = 1 To lngList
strArrFile(i - 1) = wksList.Cells(i, 1)
Next
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = strPfad
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
strFile = .FoundFiles(i)
If strFile  ThisWorkbook.FullName Then
lngAll = wksAll.Cells(Rows.Count, 1).End(xlUp).Row
lngList = wksList.Cells(Rows.Count, 1).End(xlUp).Row
If IsError(Application.Match(strFile, strArrFile, 0)) Then
blnFnd = True
strMsg = strMsg & strFile & vbLf
Set wkb = Workbooks.Open(strFile)
With wkb.Worksheets("Details")
lngData = .Cells(Rows.Count, 1).End(xlUp).Row
.Rows("2:" & lngData).Copy wksAll.Cells(lngAll + 1, 1)
wksList.Cells(lngList + 1, 1) = strFile
End With
wkb.Close 0
End If
End If
Next
End With
Application.ScreenUpdating = True
If blnFnd Then MsgBox strMsg Else MsgBox "Kein Import"
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbLf & Err.Description, 16, "Error"
End Sub


Anzeige
AW: Bereich von Mappe2 zu Mappe1 kopieren
10.10.2007 22:32:00
Mappe2
Hallo Christian,
danke für die schnelle Hilfe, werde mir Deine Lösung morgen genauer ansehen. Ein paar Dinge verstehe ich noch nicht, da muss ich mich erst ein wenig schlau machen. Geb dann nochmal eine Rückmeldung ...
Danke
Gruß
Vinz

AW: Bereich von Mappe2 zu Mappe1 kopieren
11.10.2007 06:43:00
Mappe2
Hallo Christian,
danke für dieses excellente Makro, genau so habe ich mir den Import vorgestellt. Es funktioniert einwandfrei.
Auf diese Lösung wäre ich mit meinen bescheidenen Kenntnissen nie gekommen. Ich muss zugeben, dass ich es auch noch nicht ganz verstehe, was es macht, aber das erforsche ich auch noch. ;-))
Jetzt muss ich nur noch zusehen, dass nach dem erfolgten Import der Daten (Übersicht-Spalten A:Q) die Formeln der angrenzenden Spalten (Übersicht-Spalten R:X) für die importierten Daten auch nachgezogen werden.
Nochmals vielen Dank für die Hilfe
Gruß
Vinz

Anzeige
AW: Bereich von Mappe2 zu Mappe1 kopieren
11.10.2007 17:48:03
Mappe2
Hallo Vinz,
freut mich, wenn's gefällt.
Die Funktionen kannst du (wenn sie entsprechend aufgebaut sind) einfach nach unten ausfüllen.
Nehmen wir mal an, in den Zellen R2 bis X2 stehen die Funktionen.
Dann einfach folgenden Zeilen vor dem "Application.ScreenUpdating = True" einfügen:

lngAll = wksAll.Cells(Rows.Count, 1).End(xlUp).Row
wksAll.Range("R2:X2").AutoFill Destination:=wksAll.Range("R2:X" & lngAll)


Gruß
Christian

AW: Bereich von Mappe2 zu Mappe1 kopieren
17.10.2007 05:55:00
Mappe2
Servus Christian,
danke für die "Erweiterung". Hatte bereits ein eigenes Makro dafür geschrieben.

Sub Formeln_ausfuellen()
Dim r1 As Range
Dim z As Long
Range("P2").Select 'nebenstehendes Feld selektieren und Ende bestimmen!
z = Selection.End(xlDown).Row
Range("R2:W2").Select
Set r1 = Range("R2:W" & z)
Selection.AutoFill Destination:=r1
End Sub


Gruß Vinz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige