Mehrere Spalten aus versch. excel files in ein file zusammenkopieren

Question

Hallo Forum

Folgendes Problem:

Habe einen Ordner mit mehreren Unterordnern. In diesen Unterordnern(Monat) befinden sich Excel files mit Rohdaten(Tagesdaten) mit folgendem Format: JJ.MM.TT_1.csv, JJ.MM.TT_2, JJ.MM.TT_3 usw. d.h. jeder Tag hat 7 files.
Von jedem dieser files möchte ich bestimmte Spalten( nicht immer dieselben ) kopieren und in ein neues Tagesfile in einem neuen Ordner schreiben.
Da dies für ein ganzes Jahr händisch etwas mühsam ist, dachte ich an ein makro-mit dem Makrorecordern hab ichs schon probiert, funktioniert aber nicht...
Da meine Programmierversuche auch nicht gklappt haben, bitte ich das Forum um Hilfe

Danke

Franz

Answer 1

Ich kann Dir keine Lösung anbieten - aber schon mal die Frage stellen, die jeder, der Dir helfen will, stellen MUSS:
Wenn es nicht immer die gleichen Spalten sind - woran erkannt man dann, WELCHE es sein sollen?

Answer 2

Hallo nostalgiker6

hab mich evtl. falsch ausgedrückt:
In jedem der 7 files pro Tag sollen andere Spalten kopiert werden z.B. file JJ.MM.TT_1 die Spalten A&B, in JJ.MM.TT_2 die Spalten E-H usw.
Natürlich bleiben die zu kopierenden Spalten aber für jeden Tag dieselben

Gruß Franz

Answer 3

Weitere Grundsatzfrage:
Wie sollen denn die Spalten in der neuen Tabelle angeordnet sein:
Untereinander, nebeneinander, teils-teils?

Answer 4

Und: Wie verhält es sich mit der Anzahl der Zeilen? Variiert die, oder ist sie immer gleich? Oder Je Tag gleich?

Answer 5

Hallo nostalgiker6

Die kopierten Spalten sollen in der neuen Tabelle nebeneinander angeordnet sein
Die Anzahl der Zeilen ist in jedem Tagesfile gleich und bleibt für alle Tage konstant

Danke

Gruß Franz

Answer 6

ich weiss nicht, ob das mit excel makros geht, aber ich würde es sowieso mit windows scripting machen.
Folgendes script als zB. "excelcopy.js" abspeichern, (natürlich die fileNames anpassen,) rechtsklick auf die js datei und "öffnen".

Dieses Script kopiert als beispiel einfach nur die zellen der eingangs datei in eine neue datei:

var fileNames = {
path: "C:/temp",
infile: "excelfile.xls",
outfile: "excelfile2.xls"
};

WScript.Echo( openExcelFile( fileNames.path + "/" + fileNames.infile ) );

function openExcelFile( fileName )
{
var excelApp = new ActiveXObject("Excel.Application");
var wbin = excelApp.Workbooks.Open( fileName );
var wbout = excelApp.Workbooks.Add();
var currentRange, currentCell, x, y;
var out = new Array();
if( wbin.Sheets.Count > 0 )
{
currentRange = wbin.Sheets(1).UsedRange;

for ( y = 0; y < currentRange.Rows.Count; y++ )
{
for ( x = 0; x < currentRange.Columns.Count; x++ )
{
currentCell = currentRange.Cells( y + 1, x + 1 ).Text;
out.push( currentCell );
wbout.ActiveSheet.Cells( y + 1, x + 1 ).Value = currentCell
}
}
}
wbout.SaveAs( fileNames.path + "/" + fileNames.outfile );

//wbin.Close();
//wbout.Close();
excelApp.Quit();
return out.join(" | ");
}

Answer 7

Zu #5:
Wenn es so ist. dann würde ICH zunächst einmal nicht kopieren, sondern die Inhalte mit "='[file.xls]tabelle'!A1" etc. "herüberholen. (A1 hier als Platzhalter für alle Möglichkeiten, file und tabelle ebenso.)
Das lässt sich durch Eingabe von "=" und anschliessendes Anclicken der gewünschten Zelle in der gewünschten Datei leicht realisieren.
Aus mir unverständlichen Gründen schreibt mein Excel2003 allerdings statt "A1" "$a$1" - die Dollarzeichen müssen natürlich entfernt werden, ehe die einmal erstellte Formel beliebig nach rechts und unten gezogen werden kann.
Ehe irgendwann die Originaldateien gelöscht oder verschoben werden, muss man allerdings das ganze Blatt kopieren und mit "Inhalte einfügen - Werte" die Formeln durch die Werte ersetzen.

Answer 8

Hallo nostalgiker6
Hallo kicia

Danke für eure Antworten
Leider bin ich ziemlicher Programmierlaie und daher etwas überfordert...

Gruß Franz

Answer 9

hi all .-)

ein nettes makro von Nepumuk das ich angepasst habe fuer ein beispiel

a1 wird kopiert

gruss nighty

Option Explicit
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
ByVal hFindFile As Long) As Long
Private Enum FILE_ATTRIBUTE
FILE_ATTRIBUTE_READONLY = &H1
FILE_ATTRIBUTE_HIDDEN = &H2
FILE_ATTRIBUTE_SYSTEM = &H4
FILE_ATTRIBUTE_DIRECTORY = &H10
FILE_ATTRIBUTE_ARCHIVE = &H20
FILE_ATTRIBUTE_NORMAL = &H80
FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Sub Start()
Dim vntFolders As Variant
Dim lngIndex As Long
vntFolders = Folderlist(ThisWorkbook.Path)
If IsArray(vntFolders) Then
For lngIndex = LBound(vntFolders) To UBound(vntFolders)
Dim DateiName As String
DateiName = Dir(vntFolders(lngIndex) & "\*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=vntFolders(lngIndex) & "\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("A1").Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
Next
End If
End Sub
Private Function Folderlist(ByVal strFolderPath As String) As Variant
Dim WFD As WIN32_FIND_DATA
Dim lngSearch As Long, lngCounter As Long
Dim strDirName As String
Dim vntFolderArray() As Variant
If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & "*", WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
Do
If CBool(WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName & vbNullChar, vbNullChar) - 1)
If (strDirName <> ".") And (strDirName <> "..") Then
lngCounter = lngCounter + 1
ReDim Preserve vntFolderArray(1 To lngCounter)
vntFolderArray(lngCounter) = strFolderPath & strDirName
End If
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
Folderlist = vntFolderArray
End If
End Function

Answer 10

hi all :-)

vielleicht zum besseren anpassen

gruss nighty

Quelle
Workbooks(DateiName).Worksheets(1).Range("A1").Copy

Ziel
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)

Path
vntFolders = Folderlist(ThisWorkbook.Path)