Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: VBA Anpassing, mit 1 Zeilen und X Spalte

VBA Anpassing, mit 1 Zeilen und X Spalte
02.11.2021 14:38:56
Hans
Guten Tag...,
Es geht um ein anpassing ein Makro, was einmal von Tino erstellt geworden ist in diese Forum.
Dies funktioniert auch sehr gut aber ablauf hat sich geändert.
Anderungswünsch:
- nur wen X Zeile 1 dan auch nur die spalte(n) kopieren, Jetzt ist es genau andersrum wenn X nicht kopieren
- und nur Kopieren wenn Spalte B ab zeile 6 ein 1 steht
in neue Sheet mit Kopfzeile alles untereinander.

https://www.herber.de/bbs/user/148905.xlsm

Danke für Ünterstütung
Beste Grüße
Hans
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Anpassing, mit 1 Zeilen und X Spalte
02.11.2021 15:43:51
{Boris}
Hi Hans,
auf die Schnelle - teste mal:

Sub filtern()
Dim C As Range, wS As Worksheet, wS2 As Worksheet, x As Long, y As Long, z As Long
Set wS = ThisWorkbook.Worksheets("Lager")
Set wS2 = ThisWorkbook.Worksheets.Add
x = 2: z = 2
With wS2
For Each C In wS.Range("B6:B100")
If C = 1 Then
.Cells(x, 1) = C.Offset(0, 1)
For y = 4 To 8
If LCase(wS.Cells(1, y)) = "x" Then
.Cells(x, z) = wS.Cells(C.Row, y)
z = z + 1
End If
Next y
x = x + 1: z = 2
End If
Next C
z = 2
For y = 4 To 8
If wS.Cells(1, y)  "" Then
.Cells(1, z) = wS.Cells(4, y)
z = z + 1
End If
Next y
.Rows(1).WrapText = False
.Columns("A:Z").AutoFit
End With
End Sub
VG, Boris
Anzeige
AW: VBA Anpassing, mit 1 Zeilen und X Spalte
03.11.2021 16:28:22
Hans
Hallo Boris,
Das sieht schon gut aus, aber mir ist ein Fehler im Beschreibung unterlaufen und wenn geht noch einen änderung
es sollte nur die spalte kopiert werden die ein X haben jetzz wird spalte c auch übertragen dies sollte nicht sein.
und wie im Bespieldatei: Dialogfenster "Speichern unter" mit Tabelleblat name die im Zelle J2 geschrieben ist, Tabellenblatt wird als Datei gespeichert.
und als extra wünsch wenn's geht:-) nach kopieren in Tabellenblatt Lager Spalte B wert 1 ersetzen/überschreiben mit wert 2 hintergrund da bedingetn Formatierung Ampelstatus.
Deine Code hab ich so gut wie es geht für mich kommentiert aber kopieren Spalte C hab ich nicht geschafft zu unterbinden

Sub filtern()
Dim C As Range, wS As Worksheet, wS2 As Worksheet, x As Long, y As Long, z As Long
Set wS = ThisWorkbook.Worksheets("Lager")
Set wS2 = ThisWorkbook.Worksheets.Add
x = 2: z = 2
With wS2
For Each C In wS.Range("B6:B100") 'Zellbereich
If C = 1 Then   'wenn 1
.Cells(x, 1) = C.Offset(0, 1) 'erste(1)Zeile X
For y = 4 To 8   'Spalten bereich
If LCase(wS.Cells(1, y)) = "x" Then
.Cells(x, z) = wS.Cells(C.Row, y)
z = z + 1
End If
Next y
x = x + 1: z = 2 'Spalte
End If
Next C
z = 1
For y = 4 To 8 'Spalten bereich
If wS.Cells(1, y)  "" Then
.Cells(1, z) = wS.Cells(4, y) 'Zeile 4 kopieren neue tabellenblatt nach zeile 1
z = z + 1 'Spalte
End If
Next y
.Rows(1).WrapText = False
.Columns("A:Z").AutoFit
End With
End Sub
Beste Grüße
Hans
Anzeige
AW: VBA Anpassing, mit 1 Zeilen und X Spalte
05.11.2021 13:30:43
Hans
Hallo Zusammen,
Schieb nochmal Beitrag an, und mit einen Aktuelle Beispiel.
https://www.herber.de/bbs/user/148962.xlsm
Das sieht schon gut aus, aber mir ist ein Fehler im Beschreibung unterlaufen und wenn geht noch einen änderung
es sollte nur die spalte kopiert werden die ein X haben jetzz wird spalte c auch übertragen dies sollte nicht sein.
und wie im Bespieldatei: Dialogfenster "Speichern unter" mit Tabelleblat name die im Zelle J2 geschrieben ist, Tabellenblatt wird als Datei gespeichert.
und als extra wünsch wenn's geht:-) nach kopieren in Tabellenblatt Lager Spalte B wert 1 ersetzen/überschreiben mit wert 2 hintergrund da bedingetn Formatierung Ampelstatus.
Beste Grüße
Hans
Anzeige
AW: VBA Anpassing, mit 1 Zeilen und X Spalte
08.11.2021 21:28:14
Piet
Hallo
probier bitte mal ob der Code so jetzt funktioniert. Würde mich freuen ...
mfg Piet
  • 
    Sub filtern()
    Dim C As Range, wS As Worksheet, wS2 As Worksheet
    Dim WBName As String, x As Long, y As Long, z As Long
    Set wS = ThisWorkbook.Worksheets("Lager")
    Set wS2 = ThisWorkbook.Worksheets.Add
    WBName = wS.Range("J2").Value
    x = 2: z = 2
    With wS2
    For Each C In wS.Range("B6:B100") 'Zellbereich
    If C = 1 Then   'wenn 1
    For y = 4 To 8   'Spalten bereich
    If UCase(wS.Cells(1, y)) = "X" Then
    .Cells(z, x) = wS.Cells(C.Row, y)
    x = x + 1
    End If
    Next y
    z = z + 1: x = 2 'Spalte
    C.Value = 2
    End If
    Next C
    For y = 4 To 8 'Spalten bereich
    If wS.Cells(1, y)  "" Then
    .Cells(1, x) = wS.Cells(4, y) 'Zeile 4 kopieren neue tabellenblatt nach zeile 1
    x = x + 1 'Spalte
    End If
    Next y
    .Cells.WrapText = False
    .Columns("A:Z").AutoFit
    .Copy  'AktiveSheet kopieren
    ActiveWorkbook.SaveAs WBName
    ActiveWorkbook.Close
    End With
    End Sub
    

  • Anzeige
    AW: VBA Anpassing, mit 1 Zeilen und X Spalte
    08.11.2021 21:46:34
    Piet
    Nachtrag - ich habe im Code z und x getauscht. man sollte für Spalten kein z=Zeilen verwenden. Dann kommt man im Kopf durcheinander!
    ;

    Forumthreads zu verwandten Themen

    Anzeige
    Anzeige
    Anzeige
    Anzeige
    Entdecke relevante Threads

    Schau dir verwandte Threads basierend auf dem aktuellen Thema an

    Alle relevanten Threads mit Inhaltsvorschau entdecken
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Entdecke mehr
    Finde genau, was du suchst

    Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

    Suche nach den besten Antworten
    Unsere beliebtesten Threads

    Entdecke unsere meistgeklickten Beiträge in der Google Suche

    Top 100 Threads jetzt ansehen
    Anzeige