AW: mit VBA intelligente Tabelle ansprechen
30.08.2016 00:55:06
fcs
Hallo Enno,
das kopieren der Tabelle / des ListObjects kannst du wie folgt umsetzen.
Gruß
Franz
Sub prcGet_Data_from_Text_File()
Dim wksZiel As Worksheet
Dim varText, wkbText As Workbook, wksText As Worksheet
varText = Application.GetOpenFilename("Textfile (*.txt),*.txt", _
Title:="Bitte zu importierende Textdatei auswählen", _
MultiSelect:=False)
If varText = False Then Exit Sub
Set wksZiel = ActiveSheet
Application.ScreenUpdating = False
Application.Workbooks.OpenText Filename:=varText, _
Startrow:=1, _
DataType:=xlDelimited, _
Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
local:=True
Set wkbText = Application.Workbooks(Mid(varText, InStrRev(varText, "\") + 1))
Set wksText = wkbText.Sheets(1)
wksZiel.Range("A3:AD100").ClearContents
With wksText
.Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 30)).Copy
End With
wksZiel.Range("A3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wkbText.Close savechanges:=False
Range("A3").Select
Application.ScreenUpdating = True
End Sub
Sub prcCopy_ListObject()
Dim objList As ListObject
Dim wksNeu As Worksheet, rngZiel As Range
'ListObject setzen und neues Tabellenblatt anlegen
With ActiveWorkbook
Set objList = .Worksheets(2).ListObjects(1)
'oder auch
Set objList = .Worksheets("Tabelle2").ListObjects("Wg_Umlauf")
Set wksNeu = .Worksheets.Add(After:=objList.Parent)
Set rngZiel = wksNeu.Range("A3") 'Zelle ab der Tabelle/ListObject eingefügt werden soll
End With
'Datenbereich des ListObjects koperen
With objList.Range
.Copy
rngZiel.PasteSpecial Paste:=xlPasteColumnWidths
.Application.CutCopyMode = False
.Copy Destination:=rngZiel
.Application.CutCopyMode = False
End With
'Blatt umbenennen und ListObject neu setzen
With wksNeu
.Name = "Copy WgUmlauf"
Set objList = .ListObjects(1)
objList.Name = "WgUmlauf_Neu"
End With
'Einzelne Spalten löschen
Set rngZiel = objList.Range.Rows(1).Find(what:="Korrektur Datum", LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngZiel Is Nothing Then
rngZiel.EntireColumn.Delete
End If
Set rngZiel = objList.Range.Rows(1).Find(what:="Werkstattzeit", LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngZiel Is Nothing Then
rngZiel.EntireColumn.Delete
End If
End Sub