Tabelle aus einem Sheet in anderes übertragen
14.08.2017 16:54:00
yei
langsam bin ich am verzweifeln, da ich versuche eine Tabelle, die im Vorfeld variabel aufgebaut wird, von einem Datenblatt unter bestimmten Voraussetzungen in ein anderes zu übertragen. Es will mir aber partout nicht gelingen. Ich versuche mit einer For-Schleife durch die zu kopierende Tabelle zu gehene und dann anhand mehrerer If-Anweisungen die Voraussetzungen zu definieren.
Speziell an der zu übertragenden Tabelle ist, dass es 6 Themenblöcke gibt zu denen jeweils mit Hilfe einer Id eine Anforderung definiert werden muss.
Jedes Thema nimmt in der ursprünglichen Tabelle - auf Grund von Beschreibungen und Beispielen und einem Button zum Hinzufügen oder Löschen von zusätzlichen Anforderungen - jeweils mindestens 2 Zeilen ein, wobei die Zeilen nicht relevant für das kopieren sein müssen.
Meine Tabelle sieht so ähnlich aus:
Thema Beschreibung Beispiel Id Anforderung
Thema 1 Hier steht ein Text Hier steht ein Text Thema1_1 A1_1
"" "" "" Thema1_2 A1_2
Thema 2 Text Text Thema2_1 ""
"" "" "" Thema2_2 ""
Thema 3 Text Text Thema3_1 A3_1
"" "" "" Thema3_2 ""
...
Wobei "" für leer steht
Ziel ist es das die Tabelle auf dem neuen Tabellenblatt jedes Mal nach ausführen des Makros komplett neu aufgebaut wird und Zeilen in denen keine Anforderung definiert ist auch nicht auftauchen, außer es handelt sich um die erste Zeile in der das Thema steht.
Das Endergebnis sollte so aussehen:
Thema ID Anforderung
Thema 1 Thema1_1 A1_1
"" Thema1_2 A1_2
Thema 2 "" ""
Thema 3 Thema3_1 A3_1
...
Das Versuche ich mit diesem Quellcode hinzubekommen und ich scheitere kläglich, da aus mir _ unerfindlichen Gründen die If, ElseIf und Else Anweisungen alle bei einem Durchlauf durchgegangen werden, obwohl sich diese ausschließen sollten.
Sub Makro2()
Dim Lastrow As Integer
Dim s1, s2, s3, s4, s5 As String
'Zähler für neue Tabelle
j = 15
'Letzte Tabellenzeile der zu kopierenden Tabelle endet 7 Zeilen vor dem letzten Eintrag auf _
_
_
Tabellenblatt
l = Worksheets("IP initial CR Interview").Cells(Rows.Count, 1).End(xlUp).Row
l = l - 7
'Gehe zu kopierende Tabelle durch von erster bis letzter Zeile
Range("I1") = l
For i = 22 To l
'Variablen Updaten auf neue Zeile
s1 = Sheets("IP initial CR Interview").Range("E" & i)
s2 = Sheets("IP initial CR Interview").Range("A" & i)
s3 = Range("A" & j)
s4 = Range("C" & j)
s5 = Sheets("IP initial CR Interview").Range("D" & i)
'Wenn E(i) in zu übertragender Tabelle nicht leer und A(i) nicht leer, kopiere Inhalt _
_
_
von E(i) und D(i) in neue Tabelle
If Not s1 = "" And Not s2 = "" Then
Sheets("Sheet2").Range("B" & j) = s5
Sheets("Sheet2").Range("C" & j) = s1
j = j + 1
'Wenn E(i) in zu übertragender Tabelle nicht leer ist, aber A(i) leer ist: Füge neue _
Zeile ein und fülle Zellen
ElseIf Not s1 = "" And s2 = "" Then
Rows(j & ":" & j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Sheet2").Range("C" & j) = s1
Sheets("Sheet2").Range("B" & j) = s5
j = j + 1
'Wenn s1 leer ist und s5 nicht leer ist, mache nichts
ElseIf s1 = "" And Not s5 = "" Then
'Wenn s1 leer ist und s5 nicht leer ist, gehe in nächste Zeile in neuer Tabelle
ElseIf s1 = "" And s5 = "" Then
j = j + 1
End If
Next i
End Sub
Ich habe es auch schon mit mehreren geschachtelten Anweisungen probiert, aber dort ist genau das gleiche Problem. Mir ist völlig unklar, warum erst die If Answeisung anschlägt und dann die beiden ElseIf Anweisungen und das Else danach auch. Wahrscheinlich ist es total simpel, aber ich seh es einfach nicht mehr...
Besten Dank schonmal,
yei