Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
956to960
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
956to960
956to960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten transportieren

Daten transportieren
02.03.2008 00:50:00
Dieter.G
Hallo zusammen,
ich brauche mal wieder Euere Hilfe.
Mein Problem hab ich in der Beispielmappe beschrieben!

Die Datei https://www.herber.de/bbs/user/50340.xls wurde aus Datenschutzgründen gelöscht


Danke im Voraus
Gruß Dieter

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten transportieren
02.03.2008 01:15:00
chris
Hallo Dieter,
was hälst du davon ?
Hoffe es hilft Dir.
Ich habe es mal auf die schnelle erstellt.
Ohne größere fehlerabfragen.
https://www.herber.de/bbs/user/50341.xls
gruß Chris

AW: Daten transportieren
02.03.2008 10:37:00
Dieter.G
Hallo Chris,
funktioiert im Prinzip, es wäre aber für mich wichtig, die Zellen (Kalenderwochen) die transportiert werden sollen nur zu markieren anstatt die Daten in eine MsgBox einzugeben!
Gruß Díeter

AW: Daten transportieren
02.03.2008 10:42:00
Herby
Hallo Dieter,
anbei das Makro von Chris mit einer kleinen Änderung. Zuerst die
Inputbox aufrufen, dann den gewünschten Bereich markieren und
dann wird transponiert.
https://www.herber.de/bbs/user/50344.xls
viele Grüße
Herby

Anzeige
AW: Daten transportieren
02.03.2008 11:41:00
Dieter.G
Hallo Herby,
wie gesagt, am besten wäre das ganze ohne InputBox.
Wenn das nicht möglich ist, dann müßte bei Deiner Version noch die Meldung, wenn ich bei der InputBox auf "OK" Klicke aber nichts markiert wurde, durch einen Hinweis z.B. "Es wurden noch keine Kalenderwochen markiert" ersetzt werden.
Wenn ich wenn ich bei der InputBox auf "Abbrechen" Klicke 'Laufzeitfehler 424': "Objekt erforderlich" abgefangen werden.
Danke
Gruß Dieter

AW: Daten transportieren
02.03.2008 12:07:54
Herby
Hallo Dieter,
mit Fehlerabfrangroutine:
https://www.herber.de/bbs/user/50350.xls
Viele Grüße
Herby

Anzeige
AW: Daten transportieren
02.03.2008 11:35:00
Erich
Hallo Dieter,
hier noch ne Alternative. Die Prozedur geht davon aus, dass die zu kopierenden Zeilen
VOR dem Aufruf selektiert wurden.
Sie verträgt auch Mehrfachselektionen:

Option Explicit
Sub transport2()
Dim rngSel As Range, rngAr As Range, intC As Integer
If Intersect(Selection, Columns(2)) Is Nothing Then Exit Sub
Set rngSel = Intersect(Selection, Columns(2))
If rngSel.Count > 15 Then
MsgBox ("mehr als 15 Kalenderwochen")
Exit Sub
End If
Application.ScreenUpdating = False
With Sheets("Tabelle2")
.Range("C4:Q16").ClearContents
intC = 3
For Each rngAr In rngSel.Areas
Range(Cells(rngAr.Row, 2), Cells(rngAr.Row + rngAr.Rows.Count - 1, 14)).Copy
.Cells(4, intC).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
intC = intC + rngAr.Rows.Count
Next rngAr
Application.CutCopyMode = False
.Select                             ' nur wenn nötig/gewünscht
.Cells(1, 1).Select                 ' nur wenn nötig/gewünscht
End With
Application.ScreenUpdating = True
End Sub

Und hier die Mappe zum Testen:
https://www.herber.de/bbs/user/50347.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Daten transportieren
02.03.2008 12:03:00
Dieter.G
Hallo Erich,
vielen Dank, Deine Lösung ist perfekt!!
Danke aber auch an die anderen beiden.
Gruß Dieter

AW: Daten transportieren
02.03.2008 12:05:00
Erich
Hallo Dieter,
hier noch eine Version mit Hinweis, wenn keine KW ausgewählt ist:

Sub transport2()
Dim rngSel As Range, rngAr As Range, intC As Integer
If Intersect(Selection, Columns(2)) Is Nothing Then
MsgBox ("Keine Kalenderwoche ausgewählt")
Exit Sub
End If
Set rngSel = Intersect(Selection, Columns(2))
If rngSel.Count > 15 Then
MsgBox ("mehr als 15 Kalenderwochen")
Exit Sub
End If
Application.ScreenUpdating = False
With Sheets("Tabelle2")
.Range("C4:Q16").ClearContents
intC = 3
For Each rngAr In rngSel.Areas
Range(Cells(rngAr.Row, 2), Cells(rngAr.Row + rngAr.Rows.Count - 1, 14)).Copy
.Cells(4, intC).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
intC = intC + rngAr.Rows.Count
Next rngAr
Application.CutCopyMode = False
.Select                             ' nur wenn nötig/gewünscht
.Cells(1, 1).Select                 ' nur wenn nötig/gewünscht
End With
Application.ScreenUpdating = True
End Sub

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

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige