Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1112to1116
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
Inhaltsverzeichnis

markierte zellinhalte in ein blatt kopieren

markierte zellinhalte in ein blatt kopieren
Marky
Hallo Excel Freaks !
Ich würde gerne markierte Zelleninhalte von verschiedenen Arbeitsblättern in ein Blatt kopieren
Zum besseren Verständnis hab ich zwei Mappen erstellt:
Vor Makroausführung:
https://www.herber.de/bbs/user/65488.xls
nach Makroausführung sollte es so aussehen:
https://www.herber.de/bbs/user/65489.xls
Ich hoffe es kann mir jemand von euch helfen.
LG
Marky
P.S. Ich hab die Excel sheets zwar unter Excel 2003 erstellt; die Makros sollten aber unter Excel 2000 laufen.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: markierte zellinhalte in ein blatt kopieren
31.10.2009 20:14:54
Daniel
HI
wie sollen den die zu kopierenden Zellen markiert werden?
muss daß mit Farbe geschehen oder kann das auch bspw ein Wert in Spalte I sein?
Werden immer nur die Spalten C und D kopiert?
Wenns so ist (x in Spalte I) dann könnte folgendes Makro helfen:
Sub MarkierteDatenKopieren()
Dim sh As Worksheet
Dim shZiel As Worksheet
Set shZiel = ThisWorkbook.Sheets("zusammenfassung")
With shZiel
For Each sh In ThisWorkbook.Worksheets
If sh.Name  .Name Then
If WorksheetFunction.CountIf(sh.Range("I:I"), "*") > 0 Then
Intersect(sh.Range("C:D"), sh.Range("I:I") _
.SpecialCells(xlCellTypeConstants).EntireRow).Copy
.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
.Cells(Rows.Count, 3).End(xlUp).Offset(0, -2)).Value = sh.Name
End If
End If
Next
End With
Application.CutCopyMode = False
End Sub
die zu kopierendn Werte müssen mit einem Zeichen in Spalte I markiert werden, dann werden Sie in die Zusammenfassung übertragen.
Gruß, Daniel
Anzeige
AW: markierte zellinhalte in ein blatt kopieren
31.10.2009 20:43:37
marky
Hallo Daniel !
Es sollen immer nur die Spalten c und d kopiert werden. Die Markierung erfolgt ganz normal im Excel
unter "Zellen markieren und Ausfüllfarbe auswählen. Auch das Sheet "Zusammenfassung" soll durch das Ausführen des makros aktiviert werden.
Dein Makro funktioniert im Prinzip ganz gut, so wie Du es beschrieben hast; vielen Dank dafür; glaubst Du dass du es schaffen könntest ohne setzen des x dass die zellen kopiert werden und dass das makro auch das sheet zusammenfassung generieren kann, das ja eigentlich vor makroausführung nicht existiert.
Es wäre nur das Tüpfelchen auf dem I......; das makro, so wie Du´s geschrieben hast is völlig OK.
Vielen lieben Dank
LG
Marky
Anzeige
AW: markierte zellinhalte in ein blatt kopieren
31.10.2009 20:56:09
Daniel
HI
das Einfugen eines neuen Blattes geht so:
Sub MarkierteDatenKopieren()
Dim sh As Worksheet
Dim shZiel As Worksheet
On Error GoTo Sheet_Einfügen
Set shZiel = ThisWorkbook.Sheets("Zusammenfassung")
On Error GoTo 0
With shZiel
For Each sh In ThisWorkbook.Worksheets
If sh.Name  .Name Then
If WorksheetFunction.CountIf(sh.Range("I:I"), "*") > 0 Then
Intersect(sh.Range("C:D"), sh.Range("I:I") _
.SpecialCells(xlCellTypeConstants).EntireRow).Copy
.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
.Cells(Rows.Count, 3).End(xlUp).Offset(0, -2)).Value = sh.Name
End If
End If
Next
End With
Application.CutCopyMode = False
Exit Sub
Sheet_Einfügen:
ThisWorkbook.Sheets.Add ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "Zusammenfassung"
End Sub
das suchen der Markierten Zellen über Farbe würde das Makro verkomplizieren und verlangsamen.
Gruß, Daniel
Anzeige
AW: korrektur
31.10.2009 21:10:17
Daniel
Hi
so funktionierts dann auch:
Sub MarkierteDatenKopieren()
Dim sh As Worksheet
Dim shZiel As Worksheet
On Error GoTo Sheet_Einfügen
Set shZiel = ThisWorkbook.Sheets("Zusammenfassung")
On Error GoTo 0
With shZiel
For Each sh In ThisWorkbook.Worksheets
If sh.Name  .Name Then
If WorksheetFunction.CountIf(sh.Range("I:I"), "*") > 0 Then
Intersect(sh.Range("C:D"), sh.Range("I:I") _
.SpecialCells(xlCellTypeConstants).EntireRow).Copy
.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
.Cells(Rows.Count, 3).End(xlUp).Offset(0, -2)).Value = sh.Name
End If
End If
Next
End With
Application.CutCopyMode = False
Exit Sub
Sheet_Einfügen:
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "Zusammenfassung"
Resume
End Sub
Gruß, Daniel
Anzeige
AW: korrektur
31.10.2009 22:27:16
marky
Hi Daniel !
Vielen Dank für Deine Bemühungen; Du bist echter Profi und hast mir sehr weitergeholfen.
Liebe Grüße
Marky

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige