Microsoft Excel

Herbers Excel/VBA-Archiv

Zuordnung von Daten

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