Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1372to1376
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
1372to1376
1372to1376
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Format in 2.Reiter kopieren

Format in 2.Reiter kopieren
08.08.2014 10:37:14
Nik
Hi,
Kann mir jemand helfen das Format der Spalten BB bis BK in einen2.Reiter zu kopieren?
Immer wenn eine Zeile angeklickt wird, soll das Format in den Spalten in dieser Zeile übernommen werden...
Mein Code momentan sieht so aus:
Für die "Kreuze" der 1.Code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim RaBereich As Range
Set RaBereich = Range("BB2:BK1000000")
If Not Intersect(Target, RaBereich) Is Nothing Then
If Target.Borders(xlDiagonalDown).LineStyle = 1 Then
With Target
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Else
With Target
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Weight = xlThick
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalUp).Weight = xlThick
End With
End If
Cancel = True
End If
Set RaBereich = Nothing
End Sub
Für die Zuteilung zum w. Reiter dieser Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws2 As Worksheet
Dim aktZeile As Long
Set ws2 = ThisWorkbook.Worksheets("Messauftrag")
If Target.Rows.Count > 1 Then Exit Sub
aktZeile = Target.Row
ws2.Range("B5") = Me.Cells(aktZeile, "B")
ws2.Range("B6") = Me.Cells(aktZeile, "C")
ws2.Range("B7") = Me.Cells(aktZeile, "F")
ws2.Range("B8") = Me.Cells(aktZeile, "G")
ws2.Range("B9") = Me.Cells(aktZeile, "AP")
ws2.Range("B10") = Me.Cells(aktZeile, "K")
ws2.Range("B11") = Me.Cells(aktZeile, "AM")
ws2.Range("E5") = Me.Cells(aktZeile, "I")
ws2.Range("E6") = Me.Cells(aktZeile, "J")
ws2.Range("E7") = Me.Cells(aktZeile, "BM")
ws2.Range("E8") = Me.Cells(aktZeile, "BN")
ws2.Range("E9") = Me.Cells(aktZeile, "BO")
ws2.Range("B16") = Me.Cells(aktZeile, "AQ")
ws2.Range("B17") = Me.Cells(aktZeile, "N")
ws2.Range("B18") = Me.Cells(aktZeile, "AN")
ws2.Range("B19") = Me.Cells(aktZeile, "AF")
ws2.Range("B20") = Me.Cells(aktZeile, "AJ")
ws2.Range("B21") = Me.Cells(aktZeile, "AC")
ws2.Range("B22") = Me.Cells(aktZeile, "AG")
ws2.Range("B23") = Me.Cells(aktZeile, "AB")
ws2.Range("B24") = Me.Cells(aktZeile, "AD")
ws2.Range("B25") = Me.Cells(aktZeile, "AE")
ws2.Range("B26") = Me.Cells(aktZeile, "AI")
ws2.Range("B27") = Me.Cells(aktZeile, "R")
ws2.Range("E16") = Me.Cells(aktZeile, "S")
ws2.Range("E17") = Me.Cells(aktZeile, "T")
ws2.Range("E18") = Me.Cells(aktZeile, "U")
ws2.Range("E19") = Me.Cells(aktZeile, "W")
ws2.Range("E20") = Me.Cells(aktZeile, "Y")
ws2.Range("E21") = Me.Cells(aktZeile, "V")
ws2.Range("E22") = Me.Cells(aktZeile, "X")
ws2.Range("E23") = Me.Cells(aktZeile, "Z")
ws2.Range("E24") = Me.Cells(aktZeile, "AA")
ws2.Range("B32") = Me.Cells(aktZeile, "BB")
ws2.Range("B33") = Me.Cells(aktZeile, "BC")
ws2.Range("B34") = Me.Cells(aktZeile, "BD")
ws2.Range("B35") = Me.Cells(aktZeile, "BE")
ws2.Range("B36") = Me.Cells(aktZeile, "BF")
ws2.Range("B37") = Me.Cells(aktZeile, "BG")
ws2.Range("B38") = Me.Cells(aktZeile, "BH")
ws2.Range("B39") = Me.Cells(aktZeile, "BI")
ws2.Range("B40") = Me.Cells(aktZeile, "BJ")
ws2.Range("B41") = Me.Cells(aktZeile, "BK")
ws2.Range("E32") = Me.Cells(aktZeile, "AR")
ws2.Range("E33") = Me.Cells(aktZeile, "AS")
ws2.Range("E34") = Me.Cells(aktZeile, "AT")
ws2.Range("E35") = Me.Cells(aktZeile, "AU")
ws2.Range("E36") = Me.Cells(aktZeile, "AV")
ws2.Range("E37") = Me.Cells(aktZeile, "AW")
ws2.Range("E38") = Me.Cells(aktZeile, "AX")
ws2.Range("E39") = Me.Cells(aktZeile, "AY")
ws2.Range("E40") = Me.Cells(aktZeile, "AZ")
ws2.Range("E41") = Me.Cells(aktZeile, "BA")
End Sub

Jetzt wird momentan aber der Inhalt der Spalten BB bis BK kopiert und nicht das Format
Danke schon mal..

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Format in 2.Reiter kopieren
08.08.2014 15:17:59
Dieter
Hallo Nik,
ist jetzt aus Alexa Nik geworden?
Das Umkopieren der Formate würde ich so machen:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Tabelle2")
If Target.Rows.Count > 1 Then Exit Sub
aktZeile = Target.Row
If (aktZeile  aktZeileOld) Then
Format_übertragen Me.Cells(aktZeile, "B"), ws2.Range("B5")
Format_übertragen Me.Cells(aktZeile, "C"), ws2.Range("B6")
End If
End Sub
Sub Format_übertragen(rngQuelle As Range, _
rngZiel As Range)
rngQuelle.Copy
rngZiel.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = xlCut
End Sub
Viele Grüße
Dieter

Anzeige
AW: Format in 2.Reiter kopieren
08.08.2014 16:10:31
fcs
Hallo Nik,
um die Formate ins 2. Blatt zu übertragen muss man die Zellen kopieen und per PasteSpecial nur die Formate einfügen.
Dazu kann man das Makro wie folgt anpassen.
Damit die Kopieraktion nicht bei jeder zellselektion anläuft hab ich noch eine 2. Prüfung eingebaut.
Gruß
Franz 
'Für die Zuteilung zum w. Reiter dieser Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws2 As Worksheet
Dim aktZeile As Long
Dim lngSpalte As Long, strSpalte As String, strZelle As String
Set ws2 = ThisWorkbook.Worksheets("Messauftrag")
If Target.Rows.Count > 1 Then Exit Sub
If Target.Column  1 Then Exit Sub
'Kopiert wird, wenn man in Zelle in Spalte A klickt oder auf die Nummer der Zeile (ganze Zeile  _
wird markiert.
aktZeile = Target.Row
Application.ScreenUpdating = False
For lngSpalte = 1 To 70 'A bis BR
strSpalte = Me.Cells(1, lngSpalte).Address(False, False, xlA1)
strSpalte = Left(strSpalte, Len(strSpalte) - 1)
Select Case strSpalte
Case "B": strZelle = "B5"
Case "C": strZelle = "B6"
Case "F": strZelle = "B7"
Case "G": strZelle = "B8"
Case "AP": strZelle = "B9"
Case "K": strZelle = "B10"
Case "AM": strZelle = "B11"
Case "I": strZelle = "E5"
Case "J": strZelle = "E6"
Case "BM": strZelle = "E7"
Case "BN": strZelle = "E8"
Case "BO": strZelle = "E9"
Case "AQ": strZelle = "B16"
Case "N": strZelle = "B17"
Case "AN": strZelle = "B18"
Case "AF": strZelle = "B19"
Case "AJ": strZelle = "B20"
Case "AC": strZelle = "B21"
Case "AG": strZelle = "B22"
Case "AB": strZelle = "B23"
Case "AD": strZelle = "B24"
Case "AE": strZelle = "B25"
Case "AI": strZelle = "B26"
Case "R": strZelle = "B27"
Case "S": strZelle = "E16"
Case "T": strZelle = "E17"
Case "U": strZelle = "E18"
Case "W": strZelle = "E19"
Case "Y": strZelle = "E20"
Case "V": strZelle = "E21"
Case "X": strZelle = "E22"
Case "Z": strZelle = "E23"
Case "AA": strZelle = "E24"
Case "BB": strZelle = "B32"
Case "BC": strZelle = "B33"
Case "BD": strZelle = "B34"
Case "BE": strZelle = "B35"
Case "BF": strZelle = "B36"
Case "BG": strZelle = "B37"
Case "BH": strZelle = "B38"
Case "BI": strZelle = "B39"
Case "BJ": strZelle = "B40"
Case "BK": strZelle = "B41"
Case "AR": strZelle = "E32"
Case "AS": strZelle = "E33"
Case "AT": strZelle = "E34"
Case "AU": strZelle = "E35"
Case "AV": strZelle = "E36"
Case "AW": strZelle = "E37"
Case "AX": strZelle = "E38"
Case "AY": strZelle = "E39"
Case "AZ": strZelle = "E40"
Case "BA": strZelle = "E41"
Case Else
strZelle = ""
End Select
If strZelle  "" Then
Me.Cells(aktZeile, lngSpalte).Copy
ws2.Range(strZelle).PasteSpecial Paste:=xlPasteFormats 'Format kopieren
ws2.Range(strZelle) = Me.Cells(aktZeile, lngSpalte) 'Wert übertragen
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige