untereinanderstehende Werte via VBA umformatieren

Hallo zusammen,
ich habe folgendes Problem, das ich gerne mit VBA lösen möchte:
Und zwar habe ich eine Tabelle, in der untereinander in verschiedenen Spalten Werte stehen, die ich auf einem weiteren Tabellenblatt hintereinander ausgeben möchte.
Ich benötige dazu ein Makro, das bspw. in Tabelle 1 alle Zeilen nach dem Eintrag v_mf sucht und die Werte daneben in ein weiteres Tabellenblatt kopiert. Danach soll nach der nächsten Zeile mit v_mf gesucht werden und diese Werte dann auf das andere Tabellenblatt hinter die anderen Werte geschrieben werden.
Das Makro soll so lange laufen, bis alle Zeilen durchsucht sind. Dass ich nur 256 Spalten zur Verfügung habe, kann vernachlässigt werden.
Hier noch ein Beispiel:
Basisdatei:
v_mf: 0,1 0,2 0,3 0,4
x_sw 1 2 3 4
v_mf: 0,5 0,6 0,7 0,8
Zieldatei:
v_mf: 0,1 0,2 0,3 0,4 0,5 0,6 0,7 0,8
Da ich von VBA fast überhaupt keine Ahnung habe, würde ich mich sehr über Eure Hilfe freuen.
Im Voraus vielen Dank!
Grüße
Harry

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
ok versuche es mal hiermit, vielleicht geht es so.

Sub FilterTabelle()
Dim Bereich As Range
Dim tempBereich As Range
Dim FilterWert As String

FilterWert = InputBox("Geben Sie den Suchbegriff ein", "Filterwert")

 'Tabellennamen anpassen********************* 
With Sheets("Tabelle1")
 If FilterWert <> "" Then
     If Application.WorksheetFunction.CountIf(.Columns(1), FilterWert & "*") > 0 Then
        
        .Rows(1).Insert Shift:=xlDown
        
        Set Bereich = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        
        Bereich.AutoFilter 1, "=" & FilterWert & "*", , , False
        
        On Error Resume Next
            Set tempBereich = .Range("A2", .Cells.SpecialCells(xlCellTypeLastCell))
        On Error GoTo 0
    
        If Not tempBereich Is Nothing Then
         'Tabellennamen anpassen********************************** 
         tempBereich.Copy Sheets("Tabelle1").Range("A2")
        End If

       .Rows(1).Delete Shift:=xlUp
     
     End If
 End If
End With


End Sub

Gruß Tino

Sub Test() Dim rngQuelle As Range Dim rngZiel As Range Dim shQuelle As Worksheet Dim shZiel As Worksheet Set shQuelle = Sheets("Tabelle1") 'Tabelle mit den Daten Set shZiel = Sheets("Tabelle2") 'Zieltabelle, hier werden die Daten hinkopiert shZ.Cells.ClearContents For Each rngQuelle In shQ.UsedRange.Columns(1).Cells Set rngZiel = shZ.Columns(1).Find(what:=rngQ.Value, lookat:=xlWhole) If rngZiel Is Nothing Then Set rngZiel = shZ.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) rngZ.Value = rngQ.Value End If Range(rngQ.Offset(0, 1), rngQ.End(xlToRight)).Copy _ shZ.Cells(rngZ.Row, Columns.Count).End(xlToLeft).Offset(0, 1) Next shZiel.Rows(1).Delete End Sub

Beliebteste Forumthreads (12 Monate)

untereinanderstehende Werte via VBA umformatieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

untereinanderstehende Werte via VBA umformatieren

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

307 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread