Microsoft Excel

Herbers Excel/VBA-Archiv

Makro funktioniert nicht richtig

Betrifft: Makro funktioniert nicht richtig von: Willi
Geschrieben am: 17.07.2008 19:03:06

Hallo Wissende,

habe ein makro welches Daten aus einer Arbeitsmappe in eine andere zeilenweise kopiert. Das Problem ist, dass ab Zeile 18 die Liste nicht weitergeführt wird und die letzte Zeile immer überschrieben wird. Weiss jemand Rat??

Sub Betraege_uebertragen()
'
    Sheets("Berechnung").Select
    Application.ScreenUpdating = False
    Range("cd148:cd174").Select
    Selection.Copy
    Windows("Daten DSM.xls").Activate
    
    Sheets(1).Select
    Range("A2").Select
    For Each Cell In Range("A2:B9")
    If ActiveCell <> "" Then
    ActiveCell(Selection.Rows.Count + 1, 1).Select
    End If
  Next
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    Range("B2").Select
    
    Sheets(1).Select
End Sub



Gruß Willi

  

Betrifft: AW: Makro funktioniert nicht richtig von: Hans-Joachim Santen
Geschrieben am: 17.07.2008 19:46:28

Hallo Willi,

Dein Bereich ist zu klein, nur 8 Zeilen
For Each Cell In Range("A2:B9")

Du willst aber 27 Werte eintragen
Range("cd148:cd174").Select

Je nachdem wie lang die Liste werden kann, soll oder darf, müsste es z.B. heißen
For Each Cell In Range("A2:B900")

Gruß Hans


  

Betrifft: AW: Makro funktioniert nicht richtig von: Willi
Geschrieben am: 17.07.2008 19:56:15

Hallo Hans,

danke dir vielmals! Das hat geholfen. Allerdings ist der Bereich Range("cd148:cd174").Select der Bereich mit den Daten die kopiert werden sollen. Dieser Bereich hat 27 Zeilen. Diese 27 Zeilen werden in der Mappe in die Kopiert wird in 27 Spalten wiedergegeben. Das mit For Each Cell In Range("A2:B9") die Zeilenanzahl vorgegeben ist, hab ich nicht erkannt. ;)
Wie auch immer, scheint zu funktionieren. Danke noch mal!!

Gruß Willi


  

Betrifft: AW: Kopieren und transponieren von: Erich G.
Geschrieben am: 17.07.2008 19:57:47

Hallo Willi,
hier 2 Alternativen, die hoffentlich das tun, was du möchtest:

Option Explicit         ' immer zu empfehlen

Sub Betraege_uebertragen1()
    Dim lngZ As Long
'
    Sheets("Berechnung").Range("cd148:cd174").Copy

    Workbooks("Daten DSM.xls").Activate
    Sheets(1).Select
    lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Cells(lngZ, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    Range("B2").Select
End Sub

Sub Betraege_uebertragen2()
    Dim lngZ As Long

    With ActiveWorkbook
        Workbooks("Daten DSM.xls").Activate
        Sheets(1).Select
        lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range(Cells(lngZ, 1), Cells(lngZ, 1 + 174 - 148)) = _
            Application.Transpose(.Sheets("Berechnung").Range("cd148:cd174").Value)
        Range("B2").Select
    End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Kopieren und transponieren von: Erich G.
Geschrieben am: 17.07.2008 20:32:21

Hi Willi,
noch eine Version - hier wird in den Spalten A und B geprüft, wo der letzte Eintrag steht,
und in die Zeile darunter geschrieben:

Sub Betraege_uebertragen3()
    Dim lngZ As Long

    With ActiveWorkbook
        Workbooks("Daten DSM.xls").Activate
        Sheets(1).Select
        lngZ = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, _
                               Cells(Rows.Count, 2).End(xlUp).Row) + 1
        Range(Cells(lngZ, 1), Cells(lngZ, 1 + 174 - 148)) = _
            Application.Transpose(.Sheets("Berechnung").Range("cd148:cd174").Value)
        Range("B2").Select
    End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Kopieren und transponieren von: Willi
Geschrieben am: 17.07.2008 20:54:34

Hallo Erich!

mensch, dir auch vielen Dank. Das perferktioniert die ganze Sache. Habs gerade ausprobiert, funktioniert Prima!!! ;))


Vielen Dank


Gruß Willi