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

Macro für Excelformular

Macro für Excelformular
21.01.2015 18:59:17
Kai

Hallo zusammen,
ich benötige dringend ein Macro für folgenden Fall:
Tabelle "Anlage" enthält mehrere Reihen in denen verschiedene Datensätze hinterlegt sind (A=Name; B=Straße; C=Ort usw.)
Nun habe ich eine weitere Tabelle "Formular" in welche die Daten aus der Tabelle "Anlage" in bestimmte Zellen per einmaligen Tastendruck eingetragen werden sollen.
z.B. der Name aus "Anlage" in Zelle A5 soll in "Formular" Zelle F6 eingefügt werden.
Für jeden Datensatz soll automatisch ein neues Tabellenblatt "FormularX" geöffnet werden.
Ich hatte mir zwar vor einem Jahr aus dem Internet einmal etwas zusammengesucht aber bin heute überhaupt nicht fündig geworden.
Besten Dank bereits im Voraus.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
ohne Beispieldatei wird das nix owT
21.01.2015 21:23:44
Ralf P.

AW: Macro für Excelformular
22.01.2015 08:48:27
Kai
Okay, zum besseren Verständnis habe ich eine Beispieldatei angefügt.
https://www.herber.de/bbs/user/95158.xlsx

AW: Macro für Excelformular
22.01.2015 09:27:44
Ralf P.
Halli Kai,
der Ansatz, den Rest der kopiererei kannst du selbst ergänzen und den Button setzen und ein Makro zuweisen.
Gruß
Ralf
Option Explicit
Sub Formular_Fuellen()
Dim wb As Workbook
Dim AnlageSht As Worksheet
Dim BlattName As String
Dim Form As Worksheet
Dim Zeile As Long
Dim URows As Long
Set wb = ActiveWorkbook
Set AnlageSht = wb.Worksheets("Anlage")
With AnlageSht
.Activate
URows = .UsedRange.Rows.Count
Zeile = ActiveCell.Row
BlattName = .Cells(Zeile, 2) & "_" & .Cells(ActiveCell.Row, 3) & "_" & .Cells(ActiveCell.Row,  _
4)
If Zeile > URows Or BlattName = "__" Then
MsgBox "Selektion außerhalb der Tabelle!", vbCritical
Exit Sub
End If
If EXIST_SHEET(BlattName) Then
If MsgBox("Blatt " & BlattName & " exitiert schon! Daten überschreiben?", vbOKCancel +  _
vbQuestion) = vbOK Then
'überschreiben
Else
Exit Sub
End If
Else
Worksheets("Formular").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = BlattName
End If
Set Form = Worksheets(BlattName)
'ab hier zellen-daten kopieren
Form.Cells(6, 6).Value = .Cells(Zeile, 2).Value
End With
End Sub
Function EXIST_SHEET(SHT As String) As Boolean
Dim Ws As Worksheet
EXIST_SHEET = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = SHT Then
EXIST_SHEET = True
Exit Function
End If
Next
End Function

Anzeige
AW: Macro für Excelformular
22.01.2015 10:43:54
Kai
Hallo Ralf,
besten Dank für die Hilfe. Ich habe die Zelldaten eingegeben und das Formular wird gefüllt. Aber er erstellt nur ein neues Tabellenblatt mit dem 1. Datensatz.

AW: Macro für Excelformular
22.01.2015 14:32:07
Ralf P.

Option Explicit
Sub Formular_Fuellen()
Dim wb As Workbook
Dim AnlageSht As Worksheet
Dim BlattName As String
Dim Form As Worksheet
Dim URows As Long
Dim Zelle As Range
Set wb = ActiveWorkbook
Set AnlageSht = wb.Worksheets("Anlage")
With AnlageSht
.Activate
URows = .UsedRange.Rows.Count
For Each Zelle In .Range(.Cells(3, 1), .Cells(URows, 1))
BlattName = Zelle.Offset(, 1) & "_" & Zelle.Offset(, 2) & "_" & Zelle.Offset(, 3)
If BlattName <> "__" Then
If EXIST_SHEET(BlattName) Then
If MsgBox("Blatt " & BlattName & " exitiert schon! Daten überschreiben?", vbOKCancel +  _
vbQuestion) = vbOK Then
'überschreiben
Else
Exit Sub
End If
Else
Worksheets("Formular").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = BlattName
End If
Set Form = Worksheets(BlattName)
'ab hier zellen-daten kopieren
Form.Cells(6, 6).Value = Zelle.Offset(, 1).Value
End If
Next
End With
End Sub
Function EXIST_SHEET(SHT As String) As Boolean
Dim Ws As Worksheet
EXIST_SHEET = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = SHT Then
EXIST_SHEET = True
Exit Function
End If
Next
End Function

Anzeige
AW: Macro für Excelformular
22.01.2015 14:47:02
Kai
Hallo Ralf,
ein Traum, alles funktioniert. Danke, Danke!

15 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige