Clever-Excel-Forum

Hallo,
Bitte um VBA Hilfe

Ich möchte via VBA jeweils in der Aktiven Zeile der Tabelle Quelle
den Zellbereich von C : H in die Tabelle Ziel in die Zellen  C4:C9 übernehmen!

siehe Beispielmappe im Anhang

Vielen Dank für Eure Hilfe


Gruß Derhard

Hi,

(12.02.2016, 12:08)derhard schrieb: [ -> ]Ich möchte via VBA jeweils in der Aktiven Zeile der Tabelle Quelle
den Zellbereich von C : H in die Tabelle Ziel in die Zellen  C4:C9 übernehmen!

so?

Sub Quelle_transponieren()
' 
' Quelle nach Ziel transponieren 
' 
Dim Zeile As Long
' 

With Sheets("Quelle")
.Zeile = ActiveCell.Row

    .Range("C" & Zeile & ":H" & Zeile).Copy
    Sheets("Ziel").Range("C4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Hi Ralf,

zuerst einmal hast du eine End With vergessen. Und danach bekomme ich dieses zu sehen:

[
Bild bitte so als Datei hochladen: Klick mich!
]

Hi Günter,

(12.02.2016, 13:07)WillWissen schrieb: [ -> ]zuerst einmal hast du eine End With vergessen. Und danach bekomme ich dieses zu sehen:

ooh, ich wußte doch, das Makro sieht komisch aus:

Option Explicit

Sub DatenRueber()
   ' 
   ' Quelle nach Ziel transponieren 
   ' 
   Dim Zeile As Long
   ' 
   
   With Sheets("Quelle")
      Zeile = ActiveCell.Row
      
      .Range("C" & Zeile & ":H" & Zeile).Copy
      Sheets("Ziel").Range("C4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
          False, Transpose:=True
      Application.CutCopyMode = False
   End With
   
End Sub

Hallo Ralf,

Da Du mit activecell arbeitest, kannst Du die with Anweisung sparen,
Denn du musst dich ja in der Tabelle Quelle befindende reicht also:

Option Explicit

Sub DatenRueber()
  '
  ' Quelle nach Ziel transponieren
  '
  Dim Zeile As Long
  '
 
     Zeile = ActiveCell.Row
     
      Range("C" & Zeile & ":H" & Zeile).Copy
     Sheets("Ziel").Range("C4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=True
     Application.CutCopyMode = False
 
End Sub

Vielen Dank an Euch für die schnelle Hilfe!

funktioniert super...

Gruß Derhard