Herbers Excel/VBA-Archiv

Zuordnung von Daten

• Zuordnung von Daten von Marko vom 06.11.2020 18:27:58
• AW: Zuordnung von Daten - von Oberschlumpf am 06.11.2020 18:29:47
  • AW: Zuordnung von Daten - von Marko am 06.11.2020 18:44:15
    • AW: Zuordnung von Daten - von Werner am 06.11.2020 18:49:14
      • AW: Zuordnung von Daten - von Marko am 06.11.2020 20:07:49
        • Gerne u. Danke für die Rückmeldung. o.w.T. - von Werner am 07.11.2020 08:46:47

Betrifft: Zuordnung von Daten von: Marko
Geschrieben am: 06.11.2020 18:27:58

Hallo,

wie kann ich die Zuordnung mit dem Makro in der Tabelle "Daten" nicht immer in die nächste leere Zelle einer Spalte (B, C, D usw.), sondern nebeneinander in der gleichen Zeile übertragen werden. Der Wert in Spalte A bleibt hiervon ausgenommen. An diesem Wert in Zelle z.B. A2 sollen sich nebeneinander die Spalten B2, C2, D2 und folgende befüllen.

Ich hoffe ich konnte mich verständlich ausdrücken. Vielen Dank für Eure Unterstützung.

Private Sub Commandbutton1_Click()

Dim WkSh_Q  As Worksheet
Dim WkSh_Z  As Worksheet

   Set WkSh_Q = ThisWorkbook.Worksheets("Eingabe")
   Set WkSh_Z = ThisWorkbook.Worksheets("Daten")
   
   WkSh_Q.Range("C5").Copy
   WkSh_Z.Range("A" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
'Ab hier nicht mehr in die nächste leere Zelle der folgenden Spalten, sondern immer neben dem  _
Wert in Spalte A. z.B. Wert wurde in A2 übertragen und die nächsten Werte sollen in B2, C2, C3 übertragen werden.  

   WkSh_Q.Range("C13").Copy
   WkSh_Z.Range("B" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   WkSh_Q.Range("C15").Copy
   WkSh_Z.Range("C" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 3).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

   WkSh_Q.Range("C17").Copy
   WkSh_Z.Range("D" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 4).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   WkSh_Q.Range("C19").Copy
   WkSh_Z.Range("E" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 5).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   WkSh_Q.Range("C21").Copy
   WkSh_Z.Range("F" & WkSh_Z.Cells(WkSh_Z.Rows.Count, 6).End(xlUp).Row + 1).PasteSpecial _
   Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   Application.CutCopyMode = False

End Sub

  

Betrifft: AW: Zuordnung von Daten
von: Oberschlumpf
Geschrieben am: 06.11.2020 18:29:47

Hi Marko,

in einer Bsp-Datei, von dir per Upload gezeigt, kommt dein Code viel besser zur Geltung.

Ciao
Thorsten

  

Betrifft: AW: Zuordnung von Daten
von: Marko
Geschrieben am: 06.11.2020 18:44:15

https://www.herber.de/bbs/user/141373.xlsm

  

Betrifft: AW: Zuordnung von Daten
von: Werner
Geschrieben am: 06.11.2020 18:49:14

Hallo,

Blattnamen anpassen.

Public Sub Transponieren()
Dim raBereich As Range

Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    Set raBereich = Union(.Range("C5"), .Range("C13"), .Range("C15"), _
    .Range("C17"), .Range("C19"), .Range("C21"))
    raBereich.Copy
    With Worksheets("Tabelle2")
        .Cells(.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row, 1) _
        .PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
End With

Application.CutCopyMode = False
Set raBereich = Nothing
End Sub

Gruß Werner

  

Betrifft: AW: Zuordnung von Daten
von: Marko
Geschrieben am: 06.11.2020 20:07:49

Perfekt !!! Vielen Dank Werner

  

Betrifft: Gerne u. Danke für die Rückmeldung. o.w.T.
von: Werner
Geschrieben am: 07.11.2020 08:46:47