Herbers Excel-Forum - das Archiv

Makro funktioniert nicht richtig

Bild

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

Bild

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

Bild

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

Bild

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

Bild

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

Bild

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

 Bild