Bereich markieren kopieren

Forumthread: Bereich markieren kopieren

Tom

Hallo liebe Gemeinde,
habe ein (für euch sicherlich kleines) Auswertungsproblem.
Grundtabelle ist ein Kassenjournal welches in Excel exportiert wurde.
Es gibt maximal 9 Spalten.
Nun müsste ich in Spalte a den Wert Z 5101 (das steht aber noch weiterer Text dahinter der variabel ist) suchen und bis zum 2 Wert (welcher mit ----- anfängt und dahinter variabel ist) alle Spalten markieren, und das ganze dann nach Tabelle 2 kopieren.
Weiteres Problem ist, dass dieser Bereich öfters vorkommt und ich alle Bereich bräuchte.
Das Journal für einen Monat umfasst ca 30.000 Zeilen.
Ich hoffe mein Problem ist halbwegs anschaulich für euch, und für einen Lösungvorschlag ausreichend dokumentiert.
Vielen dank vorab
Tom

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Bsp-Mappe?

31.05.2010 14:23:06

welga

Hi,
kannst dumal eine Bsp-Mappe hochladen?
Gruß
welga

AW: Bereich markieren kopieren

31.05.2010 14:55:26

fcs

Hallo Tom,
hier meine VBA- Lösung. Die Ausführung kann schon ein paar Sekunden dauern.
Der Fortschritt wird unten in der Statuszeile angezeigt.
Gruß
Franz

Sub Copy_Z5101()
Dim wksJournal As Worksheet, Zeile_J1 As Long, Zeile_J2 As Long, LetzteZeile As Long
Dim wksZiel As Worksheet, Zeile_Tab2 As Long
Const sSuchen1 As String = "Z 5101" 'Suchtext 1. zeile
Const sSuchen2 As String = "-----" 'Suchtext letzte Zeile
Set wksJournal = Worksheets("Journal")                          'Anpassen!
Set wksZiel = Worksheets("Tabelle2")                            'Anpassen!
'Startzeile für das Einfügen in Tabelle 2
Zeile_Tab2 = wksZiel.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Application.ScreenUpdating = False
With wksJournal
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Zellen in Spalte A (1) abarbeiten
For Zeile_J2 = 1 To LetzteZeile
If Left(.Cells(Zeile_J2, 1), Len(sSuchen1)) = sSuchen1 Then
Zeile_J1 = Zeile_J2 'Zeile mit Suchbegriff 1 merken
End If
If Left(.Cells(Zeile_J2, 1), Len(sSuchen2)) = sSuchen2 And Zeile_J1  0 Then
'Spalten 1 bis 9 des Zeielnbereichs kopieren
.Range(.Cells(Zeile_J1, 1), .Cells(Zeile_J2, 9)).Copy Destination:=wksZiel.Cells( _
Zeile_Tab2, 1)
'Nächste Einfüge Zeile in Tabelle 2
Zeile_Tab2 = Zeile_Tab2 + (Zeile_J2 - Zeile_J1) + 1
Application.StatusBar = "Bearbeite Zeile " & Zeile_J2 & " von " & LetzteZeile
Zeile_J1 = 0
End If
Next
Application.CutCopyMode = False
End With
With Application
.ScreenUpdating = True
.StatusBar = False
End With
MsgBox "Fertig"
End Sub

AW: Bereich markieren kopieren

31.05.2010 15:40:27

Tom

Super Danke erstmal,
kann es aber erst morgen wieder testen und melde mich dann.
Vielen Danke erstmal.
Beispieldatei ist leider nicht möglich da es sich um Echtdaten handelt die ich nicht uploaden darf. Ein annonymisieren wäre dann auch zu aufwendig.
Gruß Tom

AW: Bereich markieren kopieren

01.06.2010 07:15:20

Tom

SUPER Franz,
du hast mir sehr geholfen. Dass Makro funktioniert genau so wie es soll.
Vielen, vielen Dank
Tom

Beliebteste Forumthreads (12 Monate)

Forumthread: Bereich markieren kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bereich markieren kopieren

Forumthread: Bereich markieren kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread