Kommentar übertragen

Hallo
Ich habe mir einen Code gebastelt mit dem ich die Werte und die Hintergrund Farbe
aus einem Tabellenblatt in ein anderes Tabellenblatt einlese . Die beiden Tabellenblätter
befinden sich in unterschiedlichen Dateien
Das funktioniert auch soweit einwandfrei
Nun möchte ich noch die Kommentare komplett übergeben
Also mit Kommentar-Fenster
Beim kopieren gibt es immer wieder Probleme
Hier ein Ausschnitt meines Codes
Set bereich = Workbooks(Datei2).Worksheets(wks1).Range(Cells(ez, Spalte1), Cells(lz, ls))
For Each i In bereich
a = i.Address
Workbooks(Datei1).Worksheets(wks2).Range(a).Value = i.Value
Workbooks(Datei1).Worksheets(wks2).Range(a).Interior.Color = i.Interior.Color
Next i
Gruß Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub einlesenLogistikDatei2() Dim Spfad As String, Datei1 As String, Datei2 As String, wks1 As String, wks2 As String, Spalte _ As String Dim ez As Integer, lz As Integer, ls As Integer, Zeile As Integer, Spalte1 As Integer Dim bereich As Range Dim i As Variant, a As Variant wks1 = "Belegung" wks2 = "Logistik" Spfad = Worksheets(Tabelle6.Name).Range("S1").Value Datei1 = Worksheets(Tabelle6.Name).Range("S2").Value Datei2 = Worksheets(Tabelle6.Name).Range("S6").Value Spalte = "B" Spalte1 = 4 Zeile = 8 ez = 9 Call getMoreSpeed(True) lz = Workbooks(Datei2).Worksheets(wks1).Cells(Rows.Count, Spalte).End(xlUp).Row ls = Workbooks(Datei2).Worksheets(wks1).Cells(Zeile, Columns.Count).End(xlToLeft).Column Workbooks(Datei2).Activate Worksheets(wks1).Activate Set bereich = Workbooks(Datei2).Worksheets(wks1).Range(Cells(ez, Spalte1), Cells(lz, ls)) For Each i In bereich a = i.Address Workbooks(Datei1).Worksheets(wks2).Range(a).Value = i.Value Workbooks(Datei1).Worksheets(wks2).Range(a).Interior.Color = i.Interior.Color Workbooks(Datei1).Worksheets(wks2).Range(a).Comment.Text Text:=i.Comment.Text Next i Set bereich = Nothing Call getMoreSpeed(False) End Sub

Hallo Hajo
Vielen vielen Dank
Ich habe den Code zum laufen gebracht
So sieht der Code nun aus

Sub einlesenLogistikDatei2()
Dim Spfad As String, Datei1 As String, Datei2 As String, wks1 As String, wks2 As String, Spalte  _
As String
Dim ez As Integer, lz As Integer, ls As Integer, Zeile As Integer, Spalte1 As Integer
Dim bereich As Range
Dim i As Variant, a As Variant
wks1 = "Belegung"
wks2 = "Logistik"
Spfad = Worksheets(Tabelle6.Name).Range("S1").Value
Datei1 = Worksheets(Tabelle6.Name).Range("S2").Value
Datei2 = Worksheets(Tabelle6.Name).Range("S6").Value
Spalte = "B"
Spalte1 = 4
Zeile = 8
ez = 9
Call getMoreSpeed(True)
lz = Workbooks(Datei2).Worksheets(wks1).Cells(Rows.Count, Spalte).End(xlUp).Row
ls = Workbooks(Datei2).Worksheets(wks1).Cells(Zeile, Columns.Count).End(xlToLeft).Column
Workbooks(Datei2).Activate
Worksheets(wks1).Activate
Set bereich = Workbooks(Datei2).Worksheets(wks1).Range(Cells(ez, Spalte1), Cells(lz, ls))
For Each i In bereich
a = i.Address
Workbooks(Datei1).Worksheets(wks2).Range(a).Value = i.Value
Workbooks(Datei1).Worksheets(wks2).Range(a).Interior.Color = i.Interior.Color
If Not i.Comment Is Nothing Then
With Workbooks(Datei1).Worksheets(wks2).Range(a)
If .Comment Is Nothing Then
.AddComment
End If
End With
Workbooks(Datei1).Worksheets(wks2).Range(a).Comment.Text Text:=i.Comment.Text
End If
Next i
Set bereich = Nothing
Call getMoreSpeed(False)
End Sub

Gruß Christian

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread