Office: Excel 2007 Macro/VBA

Hallo,
ich bin neu hier und stecke auch schon in Schwierigkeiten.
Ich möchte ein Makro erstelle das das Wort "[Compound Results (Ch1)]" und anschließend 2 Spalten darunter die beiden Spalten "Name" (von Propan bis Dodecan) und die Spalte "Conc." mit den dazugehörigen Werten kopiert und in sheet 2 kopiert.
Und das ganze soll so lange gemacht werden bis das Wort [Compound Results (Ch1)] nicht mehr gefunden wird.
Wie mache ich das??

Im Anhang habe ich das Beispiel aufgeführt. In Sheet1 sind die Daten und in Sheet2 die herauskopierten Spalten.

Hoffe wirklich Ihr könnt mir helfen!!

Vielen Dank!!

Lg
Dev

 

Hi Dev,

Code:

Sub Kopieren()
   Dim lngZeile As Long
   Dim lngErste As Long
   For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) Step 61
      With Worksheets("Sheet2")
         lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 3
         If lngErste = 4 Then lngErste = 1
         Range(Cells(lngZeile, 2), Cells(lngZeile + 56, 2)).Copy .Cells(lngErste, 1)
         Range(Cells(lngZeile, 6), Cells(lngZeile + 56, 6)).Copy .Cells(lngErste, 2)
      End With
   Next lngZeile
End Sub

Auszuführen bei aktivem Sheet1.

Bis später,
Karin

 

Hallo Karin,
erst einmal vielen vielen Dank für deine Hilfe.
Das funktioniert zwar aber es gibt 2 Probleme.
Zum einen nimmt er beim kopieren ins neue sheet die Begriffe (M-Butyrat, 2-Pentanol, 3-Pentanol, n-Heptan) mit den passenden Werten nicht mit (siehe Anhang)

Und zum anderen Während er läuft und die Befehle ausführt kommt gegen Ende dieser Error: "Run time error 1004, Application defined or object defined error."

Hast du hier eine Idee wie man das lösen kann?


Vielen Dank!!!

LG

Dev

 

Anhang

Hier der dazugehörige Anhang.

 

Hi Dev,

falls du dich in deinem Beitrag auf einen dortigen Anhang beziehst - da gibt es keinen und ich kann mich deshalb nur auf die in deinem Eröffnungbeitrag hochgeladene Arbeitsmappe beziehen: den Laufzeitfehler kann ich nicht reproduzieren und es werden auch alle Daten übertragen. Ich habe auch mal zum Vergleich die beiden Spalten stehen lassen (allerdings um 3 Spalten nach rechts verschoben), die du in deiner Arbeitsmappe hattest.

Bis später,
Karin

 

Sorry,
in der Excel-Datei die ich dir geschickt habe funktioniert es. Da hast du Recht. Aber das ist nur ein Beispiel.
In den anderen Excel-Dateien die ich habe folgt das Wort "[Compound Results (Ch1)]" nicht immer nach dem selbern Abstand (In der Datei Neq.xls immer nach 61 Spalten), sondern der Abstand varriert.
Daher muss es eine Möglichkeit geben das Wort "[Compound Results (Ch1)]" zu suchen und dann die restlichen Befehle auszuüben.

Sorry, ist etwas kompliziert :)

Kann dir gar nicht genug danken!!

 

Hi Dev,

jeder Helfer fragt sich bei solchen Dingen immer: weshalb kann nicht schon zu Beginn eine Datei hochgeladen werden, die den tatsächlichen Bedingungen entspricht?!! Weshalb muss man erst Zeit investieren und eine Lösung finden für etwas, was überhaupt nicht benötigt wird? In der Zwischenzeit hätte man schon anderen Fragestellern helfen können, anstatt für den Papierkorb zu arbeiten!

Code:

Sub Kopieren()
   Dim lngZeile As Long
   Range("A3:F" & IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)).Copy Worksheets("Sheet2").Range("A1")
   With Worksheets("Sheet2")
      For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) To 1 Step -1
         If .Cells(lngZeile, 1) = "[Compound Results (Ch1)]" Then .Range("A" & lngZeile & ":F" & lngZeile + 1).Clear
      Next lngZeile
      .Columns("C:E").Delete
      .Columns("A").Delete
   End With
End Sub

Bis später,
Karin

 

Hallo,
na weil du in der eigentlichen Datei nicht durchblicken würdest. Sie hat 1035107 Zeile. Deshalb hab ich mir die Mühe gemacht und einen Beispiel ausgesucht, dabei habe ich leider nur vergessen, dass die Abstände unterschiedlich sind.

Sorry

 

Excel Macro

Noch eine letzte Frage...

Alles was unter dem Block "Name" steht also unter Dodecan wird nach dem Kopieren in Sheet2 mitgenommen. Siehe Excel-Datei gelb markierter Bereich.
Ist es möglich, dass so einzurichten, dass die Blöcke "Name" immer hinter einander folgen ohne das der gelb markierte Bereich mitkommt?Siehe Sheet 3.

Auch hier tauchen die Blöcke in unterschiedlichen Abständen auf.

Vielen Dank.

LG

Dev

 

Hi Dev,

ergänze den Code um die mit blauer Schriftfarbe markierte Zeile

Code:

      For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) To 1 Step -1
         If .Cells(lngZeile, 1) = "[Compound Results (Ch1)]" Then .Range("A" & lngZeile & ":F" & lngZeile + 1).Clear
         [COLOR=#0000cd]If .Cells(lngZeile, 1) = "" Then .Rows(lngZeile).Delete shift:=xlUp[/COLOR]
      Next lngZeile

Bis später,
Karin