|
Hallo zusammen,
ich habe eine Datei geschrieben, bei der aus einem Export unwichtige Spalten gelöscht werden und in eine neue Excel eingefügt werden. In Spalte A,B und F werden die Duplikate entfern, so dass z.B. ein Kommentar in der Spalte nur einmal angezeigt wird bis der nächste kommt. Jetzt sollen Spalte B,E und F ein Zeilenumbruch eingefügt werden, damit die Kommentare automatisch komplett angezeigt werden. Ich weiß leider nicht wie und wo ich das rein schreiben muss. Ich hoffe mir kann jemand helfen.
LG LiseLotte
Sub Makro1()
Dim LetzteZeile1 As Integer, LetzteZeile2 As Integer, nZeile_Ziel As Integer
nZeile_Ziel = 3
Dim z As Integer, s As Integer
a = 1
Workbooks.Open "Export1.xlsx" 'Exceldatei wird geöffnet
'Exceldatei wird geöffnet
LetzteZeile1 = ActiveSheet.UsedRange.Rows.Count 'Die Anzahl der gefüllten Zeilen wird gezählt
Range(Cells(10, 1), Cells(LetzteZeile1, 1)).Select 'Der Bereich der gefüllten Zellen wird ausgewählt
Range("J:N").Select 'Überflüssige Spalten werden ausgewählt
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft 'Überflüssige Spalten werden gelöscht
Range(Cells(10, 1), Cells(LetzteZeile1, 10)).Select 'Bereich wird ausgewählt
Selection.Copy 'Bereich wird kopiert
Workbooks.Open "P:Vorlage.xlsx" 'finale Exceldatei wird geöffnet
Sheets("ESK").Select
'Altes Ergebnis löschen
Do While Worksheets("ESK").Cells(nZeile_Ziel, 3).Value <> ""
Worksheets("ESK").Range(Cells(nZeile_Ziel, 1), Cells(nZeile_Ziel, 10)).Value = ""
nZeile_Ziel = nZeile_Ziel + 1
Loop
nZeile_Ziel = 3
Sheets("Tabelle1").Select
Cells(3, 1).Select
LetzteZeile2 = ActiveSheet.UsedRange.Rows.Count 'Die Anzahl der gefüllten Zeilen wird gezählt
ActiveSheet.Paste 'Inhalt aus der Exportdatei wird eingefügt
Dim zelle As Range
Dim zähler
Application.DisplayAlerts = False
For Each zelle In Selection
zähler = 0
Do While zelle = zelle.Offset(zähler, 0) And zähler < 32000
zähler = zähler + 1
Loop
If (zelle.Column = 1 Or zelle.Column = 2 Or zelle.Column = 8) And zähler < 32000 Then
Range(zelle, zelle.Offset(zähler - 1, 0)).Merge
End If
Next zelle
Application.DisplayAlerts = True
End Sub |