Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1460to1464
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
Inhaltsverzeichnis

Automatisches Einlesen

Automatisches Einlesen
26.11.2015 22:37:20
Sascha
Hallo,
ich habe folgendes Problem:
Ich habe eine Excel-Datei in diese möchte die Inhalte der Excel-Dateien (immer nur die erste Zeile ist gefüllt) aus dem Verzeichnis C:\export\* ins Tabellenblatt Import einspielen (dabei sollen keine doppelte Inhalte eingespielt werden). Danach soll die importierte Datei ins Verzeichnis c:\export\archiv\ * verschoben werden.
Ich habe leider keine Idee wie das mit eine Makroaufzeichnung machen soll, hat eventuell jemand für mich eine Idee?
Vorab vielen Dank.
LG
Sascha

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatisches Einlesen
27.11.2015 01:36:32
Christoph
Hallo,
eventuell so?
Habe nicht viele VBA Kenntnisse, aber vielleicht hilfts ja. Wie das klappen soll mit den nicht doppelten Werten, weiß ich leider nicht. Habe das so gelöst das nach dem zusammenführen Duplikate entfernt werden. Es werden im Moment nur Komplett gleiche Zeilen gelöscht, da ich nicht wusste ob du das so meinst, oder ob jede einzelne Zelle kontrolliert werden muss.
In der 3. letzten Zeile werden noch alle .xlsx Dateien im Ordner Export gelöscht wenn du das Hochkomma entfernst.
Gespeichert wird die Datei und Import und den aktuellen Datum.
Hoffe konnte helfen.
Gruß
Christoph
Const strPath As String = "C:\export\" 'Pfad eventuell anpassen
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
strDateiname = Dir$(strPath & "*.xlsx")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbBook = Workbooks.Open(strPath & strDateiname)
Call Bearbeiten
wkbBook.Close False ' Oder True, wenn gespeichert werden soll
Set wkbBook = Nothing
End If
strDateiname = Dir$()
Loop
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
Application.DisplayAlerts = False
Windows("Import.xlsm").Activate
Columns("A:Z").Select
Range("Z1").Activate
ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, _
8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26), Header:= _
xlYes
'Kill "C:\export\*.xlsx"'Pfad eventuell anpassen
ActiveWorkbook.SaveAs Filename:="C:\export\Archiv\Import-" & Date & ".xlsx, FileFormat:= _
xlOpenXMLWorkbook, Local:=True" 'Pfad eventuell anpassen
Application.DisplayAlerts = True
End Sub

Sub Bearbeiten()
Rows("1:1").Select
Selection.Copy
Windows("Import.xlsm").Activate
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Anzeige
AW: Automatisches Einlesen
27.11.2015 08:06:28
Sascha
Hallo Christoph,
vielen Dank für deine Mühen, leider funktioniert es bei mir nicht.
Vermutlich liegt es an mir das ich deinen Code nicht entsprechend anpassen kann.
Kannst Du eventuell mir deine Datei senden?
LG
Sascha

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige