Makro zum Daten Übertragen in Tabelle 2

[Pirat2015]

Hallo Kuwer,

vielen Dank, wie muss ich den code umschreiben, wenn ich keine Spalten zusamenfüge.
ich habe versucht von der anderen excel, wo ich spalte für spalte übertragen, den code anzupassen aber vba überträgt immer zwei zellen weiter

Also wenn ich schreibe


varZ(lngZ, 3) = varQ(lngZ, 2)
varZ(lngZ, 5) = varQ(lngZ, 3)
 
VBA überträgt in Ziel 5 und 7  

Vielen Dank

[Kuwer]

Hallo,

die Spaltennummern des Arrays müssen ja nicht mit den tatsächlichen Excelspaltennummern übereinstimmen.
Wenn wie hier

varQ = .Range("B5").Resize(.Cells(.Rows.Count, 8).End(xlUp).Row - 2, 22).Value

die erste Spalte des Arrays in der Excelspalte B (Zelle B5) beginnt, ist die 1 = B.
Bei der Ausgabe beginnt die erste Arrayspalte in Spalte D (Zelle D3), also 1 = D.

Worksheets("Tabelle1").Range("D3").Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ

Somit wandert Quellspalte B nach Zielspalte D (wenn zwischendurch keine Arrayspalten vertauscht werden ).

Gruß Uwe

[Pirat2015]

Resize(.Cells(.Rows.Count, 8).End(xlUp).Row - 2, 22).Value

was bedeutet diese abschnitt?

[Kuwer]

Hallo,

setze den Cursor auf Resize und drücke die Taste F1.

Gruß Uwe

[Pirat2015]

das mit den Reiseziel und so habe ich verstanden, ich habe auch meine Anfang und mein ende angepasst.

Aber trotzdem setze das VBA die Daten zwei Zeilen weiter.
In meiner anderen Tabelle, möchte ich keine Daten zusammen ziehen kann vielleicht an dem liegen

Ich vermutte es liegt an diese stelle:

Code:

varQ = .Range("B5").Resize(.Cells(.Rows.Count, 8).End(xlUp).Row - 2, 22).Value

ich habe das .Resize.(cells.... entfernen und und nur so schreiben

Code:

varQ = .Range("B5").Value

Dann bekomme ich aber hier:

Code:

ReDim varZ(1 To UBound(varQ, 1), 1 To 38)
  For lngZ = 1 To UBound(varQ, 1)

 
Typen Unverträglichkeit.

Kannst du mir helfen?

[Kuwer]

Hallo,

Code:

varQ = .Range("B5").Value

was soll das werden? varQ wird der Wert der Zelle B5 zugewiesen und wird somit kein Array, denn dafür sind mindestens 2 Zellen nötig. Unabhängig davon wolltest Du doch einen ganzen Bereich übertragen und nicht nur eine Zelle.

Gruß Uwe

[Pirat2015]

Hallo Leute,

ich greif das Thema hier nochmal auf.
Mit diesen Code, übertrage ich die Daten von Tabelle (Test1) in die Tabelle (Test2), gleiche Excel Tabelle.

Code:

Sub aaa()
  Dim lngZ As Long
  Dim strUeberschrift As String
  Dim strUeberschrift2 As String
  Dim varQ As Variant
  Dim varZ As Variant
  With Worksheets("Test1")
    strUeberschrift = .Range("C1").Value
    strUeberschrift2 = .Range("B3").Value
    varQ = .Range("B5").Resize(.Cells(.Rows.Count, 8).End(xlUp).Row - 2, 22).Value
  End With
  ReDim varZ(1 To UBound(varQ, 1), 1 To 38)
  For lngZ = 1 To UBound(varQ, 1)
    varZ(lngZ, 3) = varQ(lngZ, 1)
    varZ(lngZ, 5) = varQ(lngZ, 2)
    varZ(lngZ, 6) = varQ(lngZ, 6)
    varZ(lngZ, 7) = varQ(lngZ, 7) & " " & varQ(lngZ, 8) & " " & varQ(lngZ, 9)
    varZ(lngZ, 10) = varQ(lngZ, 14)
    varZ(lngZ, 11) = varQ(lngZ, 13)
    varZ(lngZ, 12) = varQ(lngZ, 12)
    varZ(lngZ, 13) = varQ(lngZ, 10)
    varZ(lngZ, 14) = varQ(lngZ, 11)
    varZ(lngZ, 18) = varQ(lngZ, 15)
    varZ(lngZ, 19) = varQ(lngZ, 16)
    varZ(lngZ, 20) = varQ(lngZ, 18)
    varZ(lngZ, 21) = varQ(lngZ, 19)
    varZ(lngZ, 24) = varQ(lngZ, 20)
    varZ(lngZ, 25) = varQ(lngZ, 21)
    varZ(lngZ, 26) = varQ(lngZ, 17)
    If Len(varZ(lngZ, 26)) Then varZ(lngZ, 27) = "??"
    varZ(lngZ, 28) = strUeberschrift
    varZ(lngZ, 29) = varQ(lngZ, 3)
    varZ(lngZ, 30) = varQ(lngZ, 4)
    varZ(lngZ, 34) = strUeberschrift
    varZ(lngZ, 1) = strUeberschrift2
  Next lngZ
  Worksheets("Test2").Range("B4").Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ
End Sub

Jetzt möchte ich noch zusätzlich zwei Zellen von der Tabelle (Test3) in die Tabelle (Test2), beim übertragen der Daten von der Tabelle (Test1), auch übertragen.
die Zellen sind B22 und B23 (festgelegt) und die müssen in der Tabelle (Test2) in Zeile AR und AT erscheinen.


Wie kann ich sowas in den bestehenden code Integrieren?

Vielen Dank

[Kuwer]

Hallo,

Sub aaa()
  Dim lngZ As Long
  Dim strUeberschrift As String
  Dim strUeberschrift2 As String
  Dim varQ As Variant, varQ2 As Variant
  Dim varZ As Variant
  With Worksheets("Test1")
    strUeberschrift = .Range("C1").Value
    strUeberschrift2 = .Range("B3").Value
    varQ = .Range("B5").Resize(.Cells(.Rows.Count, 8).End(xlUp).Row - 4, 22).Value
  End With
  varQ2 = Worksheets("Test3").Range("B22:B23").Value
  ReDim varZ(1 To UBound(varQ, 1), 1 To 45)
  For lngZ = 1 To UBound(varQ, 1)
    varZ(lngZ, 1) = strUeberschrift2
    varZ(lngZ, 3) = varQ(lngZ, 1)
    varZ(lngZ, 5) = varQ(lngZ, 2)
    varZ(lngZ, 6) = varQ(lngZ, 6)
    varZ(lngZ, 7) = varQ(lngZ, 7) & " " & varQ(lngZ, 8) & " " & varQ(lngZ, 9)
    varZ(lngZ, 10) = varQ(lngZ, 14)
    varZ(lngZ, 11) = varQ(lngZ, 13)
    varZ(lngZ, 12) = varQ(lngZ, 12)
    varZ(lngZ, 13) = varQ(lngZ, 10)
    varZ(lngZ, 14) = varQ(lngZ, 11)
    varZ(lngZ, 18) = varQ(lngZ, 15)
    varZ(lngZ, 19) = varQ(lngZ, 16)
    varZ(lngZ, 20) = varQ(lngZ, 18)
    varZ(lngZ, 21) = varQ(lngZ, 19)
    varZ(lngZ, 24) = varQ(lngZ, 20)
    varZ(lngZ, 25) = varQ(lngZ, 21)
    varZ(lngZ, 26) = varQ(lngZ, 17)
    If Len(varZ(lngZ, 26)) Then varZ(lngZ, 27) = "??"
    varZ(lngZ, 28) = strUeberschrift
    varZ(lngZ, 29) = varQ(lngZ, 3)
    varZ(lngZ, 30) = varQ(lngZ, 4)
    varZ(lngZ, 34) = strUeberschrift
    varZ(lngZ, 43) = varQ2(1, 1)
    varZ(lngZ, 45) = varQ2(2, 1)
  Next lngZ
  Worksheets("Test2").Range("B4").Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ
End Sub

Gruß Uwe

[Pirat2015]

Perfekt danke