Excel Makro

Hallo und Guten Tag,
bei einer Makro Erstellung brauche ich Hilfe, kenne mich bisher damit nicht aus.
Folgendes Problem:
Es gibt 2 Tabellenblätter, "Erfassung" und "Auswertung".
Im Tabellenblatt "Erfassung" stehen in einer oder mehreren Zeilen verschiedene Daten, die an bestimmte Stellen im zweiten Tabellenblatt "Auswertung" kopiert werden sollen.
Ein Teil der Daten soll dynamisch eingetragen werden, je nachdem ob in einer betimmten Zelle (z.B. Spalte X, Zeile 4) ein Wert größer als 0,001 vorhanden ist oder nicht. Ist der Wert kleiner oder die Zelle leer, wird es übersprungen und es soll der Wert aus der nächsten Zelle (z.B.Spalte Y, Zeile 4) geprüft werden usw.. Diese Dynamik erfasst 5 bestimmte Zellen pro Zeile.
Wenn nur ein Wert in diesen Zellen grösser als 0,001 ist, soll nur diese eine Wert und der Eintrag aus derselben Spalte, Zeile 2 (im Beispiel hier X2)kopiert werden.
Wenn z.B. drei Werte in diesen Zellen grösser als 0,001 sind, sollen nur diese drei Werte und die Einträge aus den zugehörigen Zellen derselben Spalte aus Zeile 2 kopiert werden, also drei Zeilen mit Einträgen und Werten angelegt werden.
Dann sollen, je nach Anzahl der Zeilen im ersten Tabellenblatt, die gleiche Anzahl an Tabellenblättern erstellt werden und jedes Tabellenblatt den Namen einer betimmten Zelle in der zugehörigen Zeile bekommen. Also bei Daten in nur einer Zeile ein neues Tabellenblatt bei Daten in 2 Zeilen zwei neue Tabellenbätter usw..
In der Beispieldatei kann man sehen, was ich meine.
https://www.herber.de/bbs/user/111028.xls
Vielen Dank für die Hilfe hier.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Excel Makro

31.01.2017 13:18:18

Ralf

AW: Excel Makro

31.01.2017 22:14:53

Piet

AW: Excel Makro

01.02.2017 09:09:11

Ralf

AW: Excel Makro

01.02.2017 11:12:16

Piet

AW: Excel Makro

01.02.2017 14:00:27

Ralf

AW: Excel Makro

02.02.2017 22:10:09

Piet

AW: Excel Makro

02.02.2017 22:14:45

Piet

AW: Excel Makro

06.02.2017 11:14:29

Ralf

Option Explicit '31.1.2017 Piet Herber Forum Sub Daten_kopieren() Dim lngCount As Long Dim lngRow As Long Dim j As Integer, z As Long On Error GoTo Fin Application.ScreenUpdating = False With Tabelle2 lngRow = IIf(Len(.Cells(.Rows.Count, 1)), .Rows.Count, _ .Cells(.Rows.Count, 1).End(xlUp).Row) For lngCount = 4 To lngRow Worksheets("Auswertung").Range("C4") = .Range("B" & lngCount).Value Worksheets("Auswertung").Range("C6") = .Range("E" & lngCount).Value Worksheets("Auswertung").Range("C8") = .Range("D" & lngCount).Value Worksheets("Auswertung").Range("C10") = .Range("F" & lngCount).Value Worksheets("Auswertung").Range("C12") = .Range("AD" & lngCount).Value Worksheets("Auswertung").Range("C14") = .Range("G" & lngCount).Value Worksheets("Auswertung").Range("C16") = .Range("H" & lngCount).Value Call KopieVorlageErstellen 'Schleife zum Daten einfügen ins AktiveSheet z = 30 '1.Zeile für Daten For j = 1 To 5 If Tabelle2.Range("X1").Cells(lngCount, j) "" Then ActiveSheet.Cells(z, 5) = Tabelle2.Range("X1").Cells(lngCount, j) z = z + 1 End If Next j Next lngCount End With Fin: Application.ScreenUpdating = True End Sub Sub KopieVorlageErstellen() Dim TabName As String TabName = Tabelle1.Cells(6, 3).Text With ThisWorkbook .Sheets(2).Copy After:=.Sheets(.Sheets.Count) ActiveSheet.Shapes(1).Delete ActiveSheet.Name = TabName End With End Sub 'kann entfallen - wird doppelt umbenannt !! ' ActiveSheet.Name = "Kopie " & Sheets.Count - 1

Hallo Piet,
vielen Dank für deine Hilfe.
Ich habe den Code in meine Datei eingefügt, leider klappt es noch nicht wie so, wie es benötigt wird.
Ich muss bei meiner Beschreibung des Problems nochmal ansetzen.
Das Daten kopieren erstmal klappt soweit für die Zellen, die sozusagen statisch sind. Also vom ersten Tabellenblatt von Spalte A bis Spalte V werden die Einträge ins zweite Tabellenblatt in die Zellen der Zeilen 4 bis 16 übernommen.
Die anderen Einträge der Spalten X bis AB (vom ersten Tabellenblatt), sollen sozusagen dynamisch in die Zellen der Zeilen 30 bis 34 (zweites Tabellenblatt) übernommen werden. Also wenn z.B. in einer Zeile im ersten TB der Wert in der Spalte X kleiner als 0,001 (oder die Zelle leer ist), soll im zweiten TB weder der Wert in die Zeile 30, Spalte E noch der Eintrag von der zweiten Zeile aus dem ersten TB übernommen werden.
Als Beispiel mal für die Zeilen 4 vom 1. Tabellenblatt "Erfassung" (wenn alle Werte über 0,001 liegen):
SpalteX SpalteY SpalteZ SpalteAASpalteAB
Zeile2 ZZahl1 ZZahl2 ZZahl3 ZZahl4 ZZahl5
Zeile3
Zeile4 0,15 200 0,01 1,2 10
Das würde dann so aussehen im Zweiten Tabellenblatt "Auswertung" (alle Zeilen/Zellen befüllt):
SpalteA SpalteB SpalteC SpalteD SpalteE
Zeile 30 ZZahl1 = 0,15
Zeile 31 ZZahl2 = 200
Zeile 32 ZZahl3 = 0,01
Zeile 33 ZZahl4 = 1,2
Zeile 34 ZZahl5 = 10,0
Nun sind im 1.TB einige Werte kleiner als 0,001 bzw. es gibt leere Zellen:
SpalteX SpalteY SpalteZ SpalteAASpalteAB
Zeile2 ZZahl1 ZZahl2 ZZahl3 ZZahl4 ZZahl5
Zeile3
Zeile4 200 0,0001 1,2 10
Das soll dann so aussehen:
SpalteA SpalteB SpalteC SpalteD SpalteE
Zeile 30 ZZahl2 = 200
Zeile 31 ZZahl4 = 1,2
Zeile 32 ZZahl5 = 10,0
Zeile 33
Zeile 34
Das ganze soll dann auch für weitere Zeilen aus dem 1.TB gelten, die jweils dann in die neu erstellten/kopierten Tabellenblätter eingefügt werden, diese Tabellenblätter werden im Bereich der Zeilen 30-34 unterschiedlich aussehen (je nach Ausgangslage der zugehörigen Zeilen im 1.TB, Spalten X-AB)
Ein anderer Lösungsansatz wäre, wenn immer alle Zellen übertragen werden (egal ob leer, großer oder kleiner Wert), und dann die Zeilen ausgeblendet wären, wo die Werte kleiner als 0,001 oder sie Zellen leer sind.
Das würde dann so aussehen (die Zeilen 31 und 33 sind ausgeblendet):
SpalteA SpalteB SpalteC SpalteD SpalteE
Zeile 30 ZZahl2 = 200
Zeile 32 ZZahl4 = 1,2
Zeile 34 ZZahl5 = 10,0
In diesem Fall müssten für jede ausgeblendete Zeile zwischen Zeile 30 und 34 jeweils eine Zeile zwischen Zeile 36 und 41 zusätzlich eingeblentet werden, um das Format des 2.TB zu erhalten.
Leider klappt das mit der Dastellung der Zeilen und spalten hier nicht so gut, ich hoffen man kann es trotzdem verstehen.
Vielen Dank nochmal.
MfG
Ralf

Sub test() Dim Wert As Double 'oder Variant 'Hier IF Then aendern, vorher Zelle in Wert laden For j = 1 To 5 Wert = Tabelle2.Range("X1").Cells(lngCount, j) If Wert "" And Wert > 0.1 Then '0,1 oder 0,01 selbst waehlen ActiveSheet.Cells(z, 5) = Tabelle2.Range("X1").Cells(lngCount, j) z = z + 1 End If Next j End Sub

Option Explicit '31.1.2017 Piet Herber Forum Sub Daten_kopieren_Neu() Dim lngCount As Long Dim lngRow As Long Dim j As Integer, z As Long Dim Wert As Variant On Error GoTo Fin Application.ScreenUpdating = False With Tabelle2 lngRow = IIf(Len(.Cells(.Rows.Count, 1)), .Rows.Count, _ .Cells(.Rows.Count, 1).End(xlUp).Row) For lngCount = 4 To lngRow Worksheets("Auswertung").Range("C4") = .Range("B" & lngCount).Value Worksheets("Auswertung").Range("C6") = .Range("E" & lngCount).Value Worksheets("Auswertung").Range("C8") = .Range("D" & lngCount).Value Worksheets("Auswertung").Range("C10") = .Range("F" & lngCount).Value Worksheets("Auswertung").Range("C12") = .Range("AD" & lngCount).Value Worksheets("Auswertung").Range("C14") = .Range("G" & lngCount).Value Worksheets("Auswertung").Range("C16") = .Range("H" & lngCount).Value Call KopieVorlageErstellen 'Schleife zum Daten einfügen ins AktiveSheet z = 29 '1.Zeile für Daten (z-1 setzen !!) For j = 1 To 5 Wert = CDbl(Tabelle2.Range("X1").Cells(lngCount, j)) If Wert 0 Then If Wert

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel Makro

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

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread