ich bin gerade dabei ein Tool für unser Team zu basteln stoße soeben an meine Grenzen, was VBA anbelangt und wäre um jede Hilfe dankbar.
Hintergrund:
Ich habe in Excel eine Basisliste mit verschiedenen IFRS Standards die ich kategorisiert habe. Z.B. in Spalte 22 steht ein Kreuz, wenn es sich um rein inhaltliche Informationen handelt. Nun möchte ich gerne ein Makro bauen, was die Basisliste in Spalte 22 durchgeht und jedes Mal, wenn dort ein Kreuz steht dann soll es bitte die komplette Zeile kopieren (von Spalte 1 bis 22) und in ein neues Tabellenblatt kopieren. Danach soll es wieder zurück gehen un die Basisliste nach weiteren Kreuzen durchsuchen.
Bisher sieht mein Makro wie folgt aus, aber bekomme Probleme, wenn es ein Kreuz gefunden hat und nun die Zeile kopieren in das neue Tabellenblatt (Allg. Informationen) kopieren soll.
Makro:
Sub Allgemein_Informationen()
'Definitionen der Varianten
Dim Z_StartBasisliste As Single, Z_EndeBasisliste As Single
Dim Z_StartInfo As Single, Z_EndeInfo As Single
Dim S_Basisliste As Single
Dim S_BasislisteKopie As Single
Dim S_Info As Single
Dim Info As Variant
Dim Kreuz As Variant
'Start Makro
Sheets("Basisliste").Select
dlgAbfrage.Show
'Definition Zeilen und Spalten (in denen ein Kreuz ist) in der Basisliste
Z_StartBasisliste = dlgAbfrage.dlgZStart.Value
Z_EndeBasisliste = dlgAbfrage.dlgZEnde.Value
S_Basisliste = 22
'Definition der Spalten, die kopiert werden sollen, wenn ein Kreuz gefunden wurde
S_StartBasislisteKopie = 1
S_EndeBasislisteKopie = 22
'Definition des Bereichs in der später das Kopierte stehen soll
Z_StartInfo = 4
Z_EndeInfo = 1000
S_StartInfo = 1
S_EndeInfo = 22
'Definition neues Tabellenblatt
Info = "Allg. Informationen"
'Durchsuchen der Basisliste aller Zeilen
For I = Z_StartBasisliste To Z_EndeBasisliste
'Definition der Zelle in der ein Kreuz gesucht werden soll
Kreuz = Cells(I, S_Basisliste)
If Kreuz "" Then
'Definition des Bereichs in dem neuen Tabellenblatt Info
For J = Z_StartInfo To Z_EndeInfo
For K = S_StartInfo To S_EndeInfo
If Sheets(Info).Cells(J, K) = "" Then
' --> GENAU HIER HÄNGT DERZEIT DAS MAKRO
Sheets(Info).Cells(J, K) = Sheets(Basisliste).Cells(I, S_Basisliste)
J = Z_EndeInfo
K = S_EndeInfo
End If
Next K
Next J
End If
Next I
'Wenn Basisliste komplett durchsucht wurde, dann wieder zurück auf das erste Tabellenblatt _
gehen
Sheets("Start").Select
End Sub
Vielen lieben Dank für die Hilfe im Voraus!
Grüße Steffi