Moin Leute, folgendes Problem:
Ich möchte von einem Worksheet in ein anderes Worksheet spezielle Zellen kopieren. Jedoch nur, wenn die Einträge in Spalte A gleich sind. Jedoch sagt er in der Copy Funktion in der 2. Schleife, dass ein Objekt erforderlich ist (Rot markiert). Dafür habe ich jetzt folgenden Code erstellt:
Vielleicht könnt ihr mir weiter helfen.
*Topic verschoben, VB-Tag eingefügt*
Ich möchte von einem Worksheet in ein anderes Worksheet spezielle Zellen kopieren. Jedoch nur, wenn die Einträge in Spalte A gleich sind. Jedoch sagt er in der Copy Funktion in der 2. Schleife, dass ein Objekt erforderlich ist (Rot markiert). Dafür habe ich jetzt folgenden Code erstellt:
Visual Basic-Quellcode
- Sub copyComments(ByVal clSource As String, ByVal clDest As String, ByVal bereichEnde As Integer)
- ' Funktion zum Kopieren der Kommentare
- Dim sourceRange As Range ' Bereich im Quellblatt
- Dim destRange As Range ' Bereich im Zielblatt
- Dim zeile As Integer ' Zaehlvariable fuer die aktuelle Zeile
- Dim zeileSource As Long, zeileDest As Long, lastRowSource As Long, lastRowDest As Long
- Dim ValueOfPoint As String
- If clSource <> "No" Then
- lastRowSource = Worksheets(clSource).Cells(Rows.Count, 1).End(xlUp).Row
- For zeileSource = 2 To lastRowSource
- ValueOfPoint = Worksheets(clSource).Cells(zeileSource, "A")
- Worksheets(clDest).Activate
- lastRowDest = Worksheets(clSource).Cells(Rows.Count, 1).End(xlUp).Row
- For zeileDest = 2 To lastRowDest
- If Worksheets(clDest).Cells(zeileDest, "A").Value = ValueOfPoint Then
- Worksheets(clSource).Activate
- Worksheets(clSource).Range(Cells(zeileSource, "J"), Cells(zeileSource, "K")).Copy
- Worksheets(clDest).Activate
- Worksheets(clDest).Range(Cells(zeileDest, "J"), Cells(zeileDest, "K")).Select
- ActiveWorksheet.Paste ' hier war die rote Markierung
- ' Kommentare kopieren und Schriftfarbe aendern
- ' Worksheets(clSource).Range(Worksheets(clSource).Cells(zeileSource, "J"), Worksheets(clSource).Cells(zeileSource, "K")).Copy Destination:=Worksheets(clDest).Range(Worksheets(clDest).Cells(zeileDest, "J"), Worksheets(clDest).Cells(zeileDest, "K"))
- ' Worksheets(clDest).Range(Worksheets(clSource).Cells(zeileSource, "J"), Worksheets(clSource).Cells(zeileSource, "K")).Font.ColorIndex = 16
- End If
- Next zeileDest
- Application.CutCopyMode = False
- Next zeileSource
- Worksheets(clSource).Activate
- Worksheets(clSource).Range("A1").Select
- End If
- End Sub
Vielleicht könnt ihr mir weiter helfen.
*Topic verschoben, VB-Tag eingefügt*
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Marcus Gräfe“ ()