Hallo Eric,
vielen Dank erstmal für deine Antwort. Dein Ansatz ist interessant, leider kann ich mir im VBA- Editor nur ein paar Dinge zusammen flicken (If, For- Schleifen) aber vieles zeichne ich auf und ändere es ab ==> so auch hier.
Ich habe die zu importierenden Dateien in einem Ordner liegen in dem auch meine Excel Datei liegt. Mit einem ersten Makro lasse ich mir die Dateien als Pfad im Sheet "Input" auflisten. Anschließend filtere ich den Dateinamen aus dem Pfad sowie deren Endung (pfm, cia, cca...).
Das klappt. Mein drittes Makro (jenes hier) fügt für jede Datei ein Tabellenblatt ein, der Name der Datei wird dabei dem jeweiligen Tabellenblatt zugewiesen. Das klappt auch, wenn ich diesen Part weglasse:
Sheets("Vorlage").Range("A1").Select
Range("B1:C500").Select
Selection.Copy
Sheets(c).Select
Range("B1").Select
ActiveSheet.Paste
Range("B1:C500").Select
Application.CutCopyMode = False
Selection.Copy
Range("D1:E500").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:C").EntireColumn.AutoFit
Columns("A:C").EntireColumn.AutoFit
Range("A1").Select
End With
Diesen Part benötige ich, da ich beim Einlesen der Datei immer Datumswerte bekomme wo ich keine haben will (z.B.: Versionsnummer in einer Datei: 1.1.7 ==> wird automatisch 01.01.2007 etc.). Habe versucht alles als Text einzufügen, habe die Spalte vorher markiert und als Text formatiert ==> hilft alles nix.
Meine Idee war die Datei mit der Endung *.cia ohne Trennung einzufügen (Trenner wäre das "ISTGLEICH". Sobald die Spalte im neuen Tabellenblatt eingefügt ist, sollen aus dem Sheet "Vorlage" die Formeln aus Zelle B1:C:500 kopiert und im aktuellen Tabellenblatt (Variable c) wieder eingefügt werden. Die beiden Formeln sehen so aus:
B1:B500 ==> =WENN(A1="";"";WENN(ISTFEHLER(FINDEN("=";A1));A1;LINKS(A1;(FINDEN("=";A1)-1))))
Vereinfacht: Wenn in Spalte A nichts steht, mach nichts, sonst prüfe ob es ein "=" gibt, wenn ja, dann den Text bis zum "=" kopieren, wenn nein, einfach den Text ganzen kopieren!
==> Daraus ergibt sich die Bezeichnung!
C1:C500 ==> =WENN((LÄNGE(A1)-LÄNGE(B1))=0;"";RECHTS(A1;LÄNGE(A1)-LÄNGE(B1)-1))
==> Daraus resultiert der Wert der Bezeichnung!
Beisiel:
Bezeichnung: "Version" in Zelle B4
Wert : "1.1.7" in Zelle C4
So will ich es haben. Anschließend will ich das ganze kopieren in Spalte D:E und die ersten 3 Spalten löschen!
Vielleicht gibt es auch einen Trick wie man sicherstellt dass nur Text eingefügt wird. Dann bräuchte ich diesen Part nicht und das Problem wäre elegant umgangen.
Ansonsten hätte ich hier den ganzen Quellcode des Makros:
Private Sub CommandButton3_Click()
Dim proof As Integer
proof = Sheets("Input").Range("A11")
If proof = 3 Then
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Range("A15:F16").Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Blätter = Sheets("Input").Range("C13")
Dim c As String
Dim cI As String
Dim ccc As String
Dim ze As Long 'Zeilennummer für Einfügen
Dim sp As Integer 'Spaltennummer für Einfügen
Dim zeI As Long 'Zeilennummer für importieren
Dim spI As Integer 'Spaltennummer für importieren
Dim zeIF As Long 'Zeilennummer für Wenn- Bedingung
Dim spIF As Integer 'Spaltennummer für Wenn- Bedingung
Dim y As Long
For y = 1 To Blätter
ze = 16 + y
sp = 6
zeI = 16 + y
spI = 1
zeIF = 16 + y
spIF = 4
c = Cells(ze, sp)
cI = Cells(zeI, spI)
ccc = Cells(zeIF, spIF)
Sheets.Add.Name = c
Move before:=Sheets("Input")
Sheets(c).Activate
If ccc = "pfo" Then
' 1) "pfo"
With ActiveSheet.QueryTables.Add(Connection:="Text;" & cI, Destination:=Sheets(c).Range("A1"))
.Name = c
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1)
.Refresh BackgroundQuery:=False
End With
ElseIf ccc = "pfm" Then
' 2) "pfm"
With ActiveSheet.QueryTables.Add(Connection:="Text;" & cI, Destination:=Sheets(c).Range("A1"))
.Name = c
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.Refresh BackgroundQuery:=False
End With
ElseIf ccc = "cia" Then
' 3) "cia"
With ActiveSheet.QueryTables.Add(Connection:="Text;" & cI, Destination:=Sheets(c).Range("A1"))
.Name = c
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnData