Zellen verketten und kopieren

Hallo Experten,
ich versuche seit zwei Tagen folgendes Problem zu lösen:
Ich habe in einer Arbeitsmappe mehrere Bereiche, die ich gern in eine neue Arbeitsmappe kopieren und gleichzeitig mit einem Textumbruch zusammenfassen möchte.
Hier die Randbedingungen:
Der Name der Quell-Arbeitsmappe kann sich mit der Zeit ändern (da er die Versionsnummer enthält). Hier müsste man wohl mit ThisWorkbook arbeiten.
Der Name des Quell-Arbeitsblattes bleibt gleich.
Die Quell-Bereiche befinden sich alle im gleichen Arbeitsblatt [Bericht] und in der gleichen Spalte, haben aber eine unterschiedliche Anzahl Zeilen. Sie können auch alle oder teilweise leer sein, dann soll der Ziel-Bereich auch leer bleiben.
Die Ziel-Bereiche sind nicht zusammenhängend, sondern in den Zellen C8, E8.

Der Makro-Rekorder hat mir etwas mit ActiveCell.FormulaR1C1 = "=TEXTJOIN(Char(10),TRUE,'[Vorlage V1.21.xlsb]Bericht'!R56C3:R60C15)" geliefert. Hier habe ich das Problem mit dem variablen Arbeitsmappen-Namen und ich mag auch die RC-Notation nicht. Evtl. könnte man das einfach umkodieren.

ich dachte eher an sowas: Range("B3").Value = CurrWB.Worksheets("Bericht").Range("C39") & vbLf & CurrWB.Worksheets("Bericht").Range("C40") - was auch funktioniert, nur bei 5+ Zeilen sehr lang wird. An einer Schleife bin ich gescheitert. Evtl. lohnt sich hier auch eine


Sub mit einer Funktion.

Die letzte Variante habe ich auch zum Laufen bekommen:


Sub Export()
Dim wkbQuelle As Workbook
Set wkbQuelle = ThisWorkbook
With wkbQuelle.Sheets("Bericht")
Set rngMec = .Range("C31:C35")
Set rngPol = .Range("C39:C45")
End With
Set wkbZiel = Workbooks.Add(1)    'erstellt eine temporäre Arbeitsmappe mit einem Tabellenblatt
'Set wkbZiel = ActiveWorkbook
rngMec.Copy
wkbZiel.Sheets(1).Range("C3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
rngPol.Copy
wkbZiel.Sheets(1).Range("E3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
With Range("C8")
.Formula = "=TEXTJOIN(Char(10), False, B3:B7)"
.Value = .Value
End With
With Range("E8")
.Formula = "=TEXTJOIN(Char(10), False, B3:B7)"
.Value = .Value
End With
End Sub

...nur finde ich das mit dem Kopieren & Einfügen nicht sehr elegant und den Code sehr lang. Und ich würde gern den eigentlich eingefügten Bereich wieder löschen, so dass nur noch die verketteten Zellen übrig bleiben.
Wie würdet ihr das lösen?
Da ich nicht weitergekommen bin, habe ich mich nun endlich mal im Forum registriert und freue mich auf eure Antworten.
Vielen Dank!
Mue

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Export() With thisworkbook.Sheets("Bericht") Set rngMec = .Range("C31:C35") Set rngPol = .Range("C39:C45") End With Set wkbZiel = Workbooks.Add(1) wkbZiel.Sheets(1).Range("C3:C7")=rngMec wkbZiel.Sheets(1).Range("E3:E9")=rngPol Range("C8")=worksheetfunction.TEXTJOIN(Char(10), False, range("B3:B7")) Range("E8")=worksheetfunction.TEXTJOIN(Char(10), False, range("B3:B7")) End Sub

Sub Forum_test() Dim wkbQuelle As Worksheet Dim rngMec As Range, rngPol As Range Set wkbQuelle = ThisWorkbook.Sheets("Stüli_Gewicht") Set rngMec = wkbQuelle.Range("C31:C35") Set rngPol = wkbQuelle.Range("C39:C45") Range("C8") = WorksheetFunction.TextJoin(chr(10), 0, rngMec) Range("E8") = WorksheetFunction.TextJoin(chr(10), 0, rngPol) End Sub

Sub Forum_test() Dim wkbQuelle As Worksheet Dim rngMec As Range, rngPol As Range Set wkbQuelle = ThisWorkbook.Sheets("Stüli_Gewicht") Set rngMec = wkbQuelle.Range("C31:C35") Set rngPol = wkbQuelle.Range("C39:C45") Range("C8") = Join(Application.Transpose(rngMec), Chr(10)) Range("E8") = Join(Application.Transpose(rngPol), Chr(10)) End Sub

Hi
wenn du R1C1 nicht magst, kannst du die Formel auch in normaler A1-Addressierung in die Zelle schreiben, entweder trotzdem in Englisch mit .Formula = "=Formeltext auf englisch mit A1-Adressen" oder sogar auf deutsch: .FormulaLocal = "=Formel auf deutsch mit A1-Adressen"
wenn du probleme mit dem Formeltext hast, schreibe die Formel von Hand in die Zelle und lies dann den Formeltext im Direktfenster mit
?Selection.Formula oder ?Selection.FormulaLocal ein.
das mit dem Variablen Dateinamen kannst du so lösen, dass du die Formel zunächst mit einem DummyText in einer Variablen erstellst und dann austauschst:


FO = "=...TextJoin(...'[xxx].Bericht'...)"
FO = Replace(FO, "xxx", CurrWB.Name)
Cells(...).Formula = FO

ähnliches geht dann auch mit Zeilennummern, falls die angepasst werden müssen.
wenn die Formel nur eine einzige Funktion ist, kannst du die üblicherweise auch mit Worksheetfunction nach VBA-Regeln verwenden:


Cells(...).Value = Worksheetfunction.TextJoin(Chr(10), True, CurrWB.Sheets("Bericht").Range("C56:O60"))

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread