VBA Import Maske

Hallo,
folgendes Problem:
ich habe eine Excel Datei mit mehreren Tabellenblättern, die Variablen darstellen. Innerhalb einer Variable sollen die Werte spaltenweise im Quartal eingetragen werden.
Meine Idee für den Import wäre als vorderstes Tabellenblatt eine Importmaske.
Man Trägt die Variable und den Zeitpunkt in die Spalten ein, die Werte zur ID stehen vorne.
Dann drückt man einen Knopf und die Werte werden mittels VBA in das entsprechende Tabellenblatt geschrieben.
Fehlermeldungen wenn etwas nicht geschrieben werden konnte, wäre natürlich super.
Oder die Daten werden ausgeschnitten und wenn etwas nicht gefunden werden konnte, bleiben diese in der Importmaske stehen.
Die Beispieldatei hängt an.
https://www.herber.de/bbs/user/105504.xlsx
Ich hoffe ich konnte mein Problem verdeutlichen.
Könnte mir dabei jemand helfen oder Tipps geben?
Viele Grüße

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo FWEB,
ein entsprechendes Makro schaut etwa wie folgt aus.
Gruß
Franz

Sub prcEinfuegen()
Dim wksMaske As Worksheet, SpaMaske As Long, ZeiMaske As Long
Dim wksZiel As Worksheet, SpaZiel As Long, ZeiZiel As Long
Dim Blattname As String, Q_Jahr As String, varID As Variant
Dim Zelle As Range
Set wksMaske = Worksheets("Importmaske")
With Application
.ScreenUpdating = False
End With
With wksMaske
For SpaMaske = 6 To .Cells(4, .Columns.Count).End(xlToLeft).Column
Blattname = .Cells(3, SpaMaske).Text
Q_Jahr = .Cells(4, SpaMaske).Text
For Each wksZiel In ActiveWorkbook.Worksheets
If LCase(wksZiel.Name) = LCase(Blattname) Then
Exit For
End If
Next
If wksZiel Is Nothing Then
MsgBox "Das Blatt """ & Blattname & """ ist nicht vorhanden!"
Else
Set Zelle = wksZiel.Range("1:1").Find(What:=Q_Jahr, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle Is Nothing Then
MsgBox "Quartal """ & Q_Jahr & """ in Blatt """ & Blattname _
& """ nicht gefunden!"
Else
SpaZiel = Zelle.Column
For ZeiMaske = 5 To .Cells(.Rows.Count, 5).End(xlUp).Row
varID = .Cells(ZeiMaske, 5).Value
With wksZiel
For ZeiZiel = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(ZeiZiel, 1).Value = varID Then
.Cells(ZeiZiel, SpaZiel).Value _
= wksMaske.Cells(ZeiMaske, SpaMaske).Value
wksMaske.Cells(ZeiMaske, SpaMaske).ClearContents
Exit For
End If
Next ZeiZiel
End With 'wksZiel
Next
End If
End If
Next
End With 'wksMaske
With Application
.ScreenUpdating = True
End With
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread