Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 18:04:29
Formel fehler Wert#
18.04.2024 17:45:21
Shellkommando ausführen, stderr auslesen
18.04.2024 17:41:41
Summe: Bestimmter Bereich mit sverweis
18.04.2024 16:33:24
Worksheets variable
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
884to888
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kommentare übernehmen

Kommentare übernehmen
12.07.2007 12:32:00
Anja
Hey Leute,
hab ein Problemchen.
Möchte gern aus einem anderen Excel-Document aus mehreren Sheets jeweils eine Zeile übernehmen,
aber nur die Inhalte und Kommentare.
Wie kann ich das clever lösen?
Mein makrorecorder gibt mir das aus für "copy 1 Zeile aus einem Sheet":
Brauch es aber für mehrere Sheets.

Sub Macro7()
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Mai"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E59").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub


Hat vielleicht von euch einer eine Idee? Das wäre total supi.
Gruß Anja

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kommentare übernehmen
12.07.2007 12:57:27
Chaos
servus,

Sub sh()
Dim ws As Worksheet
Dim n As String
n = ActiveSheet.Name
For Each ws In ActiveWorkbook.Worksheets
If ws.Name  n Then
ws.Activate
Sheets(n).Range("F154:AJ154").Copy
ws.Range("E59").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
Selection.PasteSpecial Paste:=xlValues
End If
Next
End Sub


Fügt Werte und Kommentare ein. ohne Werten(letztes Selection löschen). Code in die tabelle, aus der kopiert wird und daraus starten, sonst noch ein Sheets("xy").Activate nach Dim n as String einfügen.
Gruß
chaos

Anzeige
AW: Kommentare übernehmen
12.07.2007 13:27:00
Anja
Hi,
danke erstmal. aber funzt leider nicht ganz, weil ich aus mehreren sheets kopiere aber nur in eins einfüge und jeweils in ne andere zeile . hm... funzt das auch irgendwie?
gruß Anja

AW: Kommentare übernehmen
12.07.2007 15:08:00
Chaos
Servus Anja,
was kopierst du wohin. Beschreib mal genau, was passieren soll. So kann ich leider keine Aussage treffen.
Das geht auch. Ich muss aber wissen, was wohin soll.
Gruß
Chaos

AW: Kommentare übernehmen
12.07.2007 15:23:21
Anja
Okay, schau das ist der ganze komplette Code den ich aufgezeichnet habe.
ich habe ne Datei wo Jan-Dez je ein Sheet hat und ich will von jedem Sheet den selben bereich ("F154:AJ154") in die andere Datei kopieren nur das da Jan-Dez auf einem in einem Sheet steht.
das heißt der kopierte bereich von Jan. muß in "E15:AJ15", der von Feb. in "E26:AJ26" von März in "E37:AJ37" usw. vielleicht
kann man das mit ner schleife lösen, denn es sind immer 11 zeilen dazwischen.
weißte ungefähr wie ich mein?
wär ganz supi... :-)

Sub Kommentare()
Application.ScreenUpdating = False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Januar"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E15").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Februar"
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Februar"
Range("F154:AG154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E26").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!März"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E37").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!April"
Range("F154:AI154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E48").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Mai"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E59").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Juni"
Range("F154:AI154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E70").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Juli"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E81").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!August"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E92").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!September"
Range("F154:AI154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E103").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Oktober"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E114").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!November"
Range("F154:AI154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E125").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Urlaubsplanung_2007.xls").Activate
Application.Run "Urlaubsplanung_2007.xls!Menü"
Application.Run "Urlaubsplanung_2007.xls!Dezember"
Range("F154:AJ154").Select
Selection.Copy
Windows("Urlaubsliste 2007.xls").Activate
Range("E136").Select
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.ScreenUpdating = True
'Windows("Urlaubsplanung_2007.xls").Activate
'Application.Run "Urlaubsplanung_2007.xls!Menü"
End Sub


Anzeige
AW: Kommentare übernehmen
12.07.2007 16:09:00
Chaos
Servus,
kann ich machen, kein Problem. Kannst du die Dateien (wenn nicht zu groß) posten, dann ist es einfacher.
Sonst muss es halt ohne gehen.
Gruß
Chaos

AW: Kommentare übernehmen
12.07.2007 16:11:29
Chaos
Ach ja,
kurze Nachfrage, nur Kommentare ?
Gruß
Chaos

AW: Kommentare übernehmen
12.07.2007 18:10:25
Anja
sorry bin grad erst von arbeit heim... ja per mail könnt ich sie dir schicken, aber online nicht weil es arbeitszeug ist. wär das okay?
gruß Anja

AW: Kommentare übernehmen
12.07.2007 18:39:00
Chaos
Servus,
hab's jetzt so gelöst.

Sub Kommentare()
Dim n As String, t As String
n = ActiveWorkbook.Name
Workbooks.Open Filename:="C:\Documents and Settings\stadter\Desktop\Urlaubsplanung_2007.xls" '  _
Hier musst du noch deinen Pfad eingeben, kannst du aber auch rausnehmen, dann muss t =Active... weg und With Workbooks(t)  zu With Workbooks("Urlaubspalnung_2007.xls") werden
t = ActiveWorkbook.Name
Application.ScreenUpdating = False
With Workbooks(t)
.Sheets("Januar").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E15").PasteSpecial Paste:=xlPasteComments
.Sheets("Februar").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E26").PasteSpecial Paste:=xlPasteComments
.Sheets("März").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E37").PasteSpecial Paste:=xlPasteComments
.Sheets("April").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E48").PasteSpecial Paste:=xlPasteComments
.Sheets("Mai").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E59").PasteSpecial Paste:=xlPasteComments
.Sheets("Juni").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E70").PasteSpecial Paste:=xlPasteComments
.Sheets("Juli").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E81").PasteSpecial Paste:=xlPasteComments
.Sheets("August").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E92").PasteSpecial Paste:=xlPasteComments
.Sheets("September").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E103").PasteSpecial Paste:=xlPasteComments
.Sheets("Oktober").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E114").PasteSpecial Paste:=xlPasteComments
.Sheets("November").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E125").PasteSpecial Paste:=xlPasteComments
.Sheets("Dezember").Range("F154:AJ154").Copy
Workbooks(n).Sheets(1).Range("E136").PasteSpecial Paste:=xlPasteComments
ActiveWorkbook.Close
End With
Application.ScreenUpdating = True
End Sub


Kopiert nur Kommentare. der Code kommt in Tabelle1 von Urlaubsliste 2007.xls und öffnet (bei richtigem Pfad) Urlaubsplanung_2007.xls und kopiert die Kommentare an die gewünschte Stelle.
Ist jetzt aber jeweils nur für den Range F154:AJ154, so wolltest du das ja.
Falls das noch mehr Zeilen in Urlaubsplanung ist, dann kann man das auch lösen, dann muss ich dir eine Schleife einbauen.
Gruß
Chaos

Anzeige
AW: Kommentare übernehmen
12.07.2007 19:19:31
Anja
vielen vielen 1000 dank, funzt einwandfrei :-)
nur noch ne kurz Frage:
haste ein tip for me wie ich die schriftfarbe der zellen die 0 sind automatisch der hintergrundfarbe anpassen kann damit man die 0 nicht sieht? formel muß aber drin bleiben
der code ist etwa so:

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("E10:AI137")
For Each RaZelle In RaBereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "DR"
' bordeaux
RaZelle.Interior.ColorIndex = 13
RaZelle.Font.ColorIndex = 2
Case "LG"
' bordeaux
RaZelle.Interior.ColorIndex = 13
RaZelle.Font.ColorIndex = 2
Case "0"
' keine Farbe
RaZelle.Interior.ColorIndex = ?
End Select
End If
Next RaZelle
'    ActiveSheet.protect
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


gruß anja

Anzeige
AW: Kommentare übernehmen
12.07.2007 19:31:47
Chaos
Servus Anja,
so:

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("E10:AI137")
For Each RaZelle In RaBereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "DR"
' bordeaux
RaZelle.Interior.ColorIndex = 13
RaZelle.Font.ColorIndex = 2
Case "LG"
' bordeaux
RaZelle.Interior.ColorIndex = 13
RaZelle.Font.ColorIndex = 2
Case "0"
' keine Farbe
RaZelle.Interior.ColorIndex = xlNone
RaZelle.Font.ColorIndex = 2
End Select
End If
Next RaZelle
'    ActiveSheet.protect
Set RaBereich = Nothing
Application.ScreenUpdating = True
End Sub


Gruß
Chaos

Anzeige
AW: Kommentare übernehmen
12.07.2007 19:49:23
Anja
eigentlich soll nur die schrift unsichtbar werden und der hintergrund so bleiben, oder eben die schriftfarbe dem hintergrund anpassen. weißte wie ich mein? mit xlNone geht bei Font nicht.

AW: Kommentare übernehmen
12.07.2007 20:09:49
Chaos
Naja,
wie viele Möglichkeiten gibt es denn mit der Hintergrundfarbe ?
Aber xlNone bei Interior und bei Font = 2 sieht man auch nicht.
Wenn's nicht so viele bzw. bestimmte Hintergrundfarben sind, könnte man abfragen.
Also ungefähr so:
Case "0"
If RaZelle.Interior.ColorIndex = 13 Then
RaZelle.Font.ColorIndex = 13
End if
Gruß
Chaos

AW: Kommentare übernehmen
12.07.2007 18:10:44
Anja
ja nur kommentare
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige