Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1748to1752
1748to1752
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Formular auslesen und Kopieren

Forumthread: Formular auslesen und Kopieren

Formular auslesen und Kopieren
09.04.2020 10:57:15
Joschka
Hallo zusammen,
leider habe ich keine VBA Kenntnisse und komme mit dem "normalen" Excel nicht weiter.
Ich habe ein Formular erstellt, welches von verschieden Personen ausgefüllt wird. Um eine bessere Übersicht zu erhalten, möchte ich diese Formulare in einer weiteren Datei (Datei 1) tabellarisch darstellen. Dafür sollen alle Formulare/Dateien in einem Ordner ausgelesene werden. Den Pfad des Ordners möchte ich jedes mal neu wählen können.
Das VBA müsste wie folgt aussehen:
Button Drücken (Datei 1)
Ordern mit mehrere Excel Formularen auswählen (ohne die Dateien zu öffnen) (Datei 2)
Alle alten Einträge ab inkl. Zeile 7 löschen, sodass keine Dopplungen vorkommen (Datei 1)
Bestimme Zellen aus Formular kopieren (C8, Q8, I22 und weitere) (Datei 2)
Inhalt in bestimmte Zelle kopieren C8 in E, Q8 in H und I22 in C ab Zeile 7 (Datei 1)
Ende
Datei 1: Zieldatei, in der die Informationen aus Formular eingefügt werden sollen und in der das Makro steht.
Datei 2: alle Formulare in einem Ordner ohne Unterordner, welches ausgewählt werden soll und aus der die Informationen kopiert werden sollen
Mir würde das ganze so viel arbeit sparen, aber ich bekomme es nicht hin. Kann mir hier jemand helfen?
Vielen DANK im Voraus!
Gruß, Joschka
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: ähnliche Frage
09.04.2020 11:12:12
Fennek
Hallo,
vor wenigen Tagen gab es hier im Forum eine ähnliche Frage:
https://www.herber.de/forum/messages/1751281.html
Ohne eine Beispieldati wird aber vermutlich wenig konkretes zu sagen sein.
mfg
AW: Formular auslesen und Kopieren
09.04.2020 11:38:26
Joschka
Danke für die schnelle Info! Hatte mir das schon angesehen aber leider kam ich nciht weiter.
Ich habe die Dateien mit hochgeladen, vllt. kannst bringt das was?
Es wäre super, wenn es eine Lösung gibt!
Formular: https://www.herber.de/bbs/user/136563.xlsm
Übersicht: https://www.herber.de/bbs/user/136564.xlsm
Alle Markos die bisher drin sind, können gelöscht werden.
Danke!
Anzeige
AW: kostenlose Dienstleistung? Nein danke
09.04.2020 16:19:35
Fennek
Hallo,
um eine Schleife über alle Dateien eines Ordners zu legen:

sub Schleife_ueber_alle_xlsx_eines_Ordners()
dim WB as workbook
const Pfad as string = "c:\temp\"
f = dir(Pfad & "*.xlsx")
do while len(f)
set wb = workbooks.open(Pfad & f)
'hier die Zurordnung
'Thisworkbook.sheets(1).cells(i,j) = wb.sheets(1).cells(k,j)
wb.close 0
f = dir
loop
end sub
Da ich keine Systematik zwischem den Zeilen des Formulars und der Datenbank gefunden habe, muss jedes Feld einzeln zugeordnet werden. Einfach, aber eine Fleißarbeit.
mfg
Anzeige
AW: Formular auslesen und Kopieren
09.04.2020 23:56:15
fcs
Hallo Joschka,
hier ein Makro um die Dateien abzuarbeiten und die Daten einzulesen.
Es werden die Werte übertragen.
Den Weg über geschlossene Dateien mussst du dir woanders besorgen. Ich persönlich bevorzuge den Weg die Quell-Dateien kurzzeitig schreibgeschützt zu öffnen.
Ggf. solltest du in den Zeilen 7 und 8 noch die Formate anpassen, damit die Anzeige der Daten korrekt ist. Gilt z.B. für das Antragsdatum in Spalte C.
LG
Franz
Sub prcImportData()
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim zeiZiel As Long, zeiZiel_1 As Long, zeiLast As Long
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, sDateiQuelle As String
Dim arrZellen() As Variant, intZ As Long
Dim varOrdner
Dim StatusCalc As Long
'Ordner-Auswahl
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit Dateien auswählen deren Daten importiert werden sollen"
.AllowMultiSelect = False
If .Show = -1 Then
varOrdner = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Zuordnung der zu kopierenden Zellen zu den Ziel Spalten
intZ = 3 'Anzahl ggf. anpassen
ReDim arrZellen(1 To intZ, 1 To 2)
'C8 in E, Q8 in H und I22 in C
'in der 1. Spalte des Arras steht die Quellzelle, in der 2. Spalte die Nummer Zielspalte
intZ = 1: arrZellen(intZ, 1) = "C8": arrZellen(intZ, 2) = 5
intZ = intZ + 1: arrZellen(intZ, 1) = "Q8": arrZellen(intZ, 2) = 8
intZ = intZ + 1: arrZellen(intZ, 1) = "I22": arrZellen(intZ, 2) = 3
'usw.
'Zielobjekte zuweisen
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Übersicht")
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
'Altdaten löschen
zeiZiel_1 = 7               '1. Einfüge-Zeile
With wksZiel
zeiLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
If zeiLast >= zeiZiel_1 Then
'Werte löschen
.Range(.Rows(zeiZiel_1), .Rows(zeiLast)).ClearContents
If zeiLast >= zeiZiel_1 + 2 Then
'alle Formate in den Zeilen lösche bis auf die 1. beiden Datenzeilen
.Range(.Rows(zeiZiel_1 + 2), .Rows(zeiLast)).Delete shift:=xlShiftUp
End If
End If
End With
'quelldateien im Ordner suchen und abarbeiten
sDateiQuelle = Dir(varOrdner & "\*.xls*", vbNormal)
zeiZiel = zeiZiel_1
Do Until sDateiQuelle = ""
Application.StatusBar = "Datei Nr. " & zeiZiel - 6 & " wird bearbeitet"
'Quelldatei schreibgeschützt öffnen
Set wkbQuelle = Application.Workbooks.Open(Filename:=varOrdner & "\" _
& sDateiQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets(1)
With wksQuelle
wksZiel.Cells(zeiZiel, 2).Value = zeiZiel - zeiZiel_1 + 1
For intZ = 1 To UBound(arrZellen, 1)
wksZiel.Cells(zeiZiel, arrZellen(intZ, 2)).Value = .Range(arrZellen(intZ, 1))
Next intZ
End With
zeiZiel = zeiZiel + 1
wkbQuelle.Close savechanges:=False
sDateiQuelle = Dir
Loop
With wksZiel
If zeiZiel > zeiZiel_1 + 2 Then
'Zeilen-Formate kopieren
.Rows(zeiZiel + 1).Copy
.Range(.Rows(zeiZiel + 2), .Rows(zeiLast)).PasteSpecial Paste:=xlPasteFormats
End If
End With
'Makrobremsen zurücksetzen
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub

Anzeige
AW: Formular auslesen und Kopieren
15.04.2020 07:17:34
Joschka
Hallo Fennek und Franz,
das ist ja super, danke!
Ich hatte nicht erwartet eine so geniale Hilfe zubekommen. Ich danke euch vielmals für Eure einzigartige Unterstützung!
Vielen Dank!
Joschka
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige