Live-Forum - Die aktuellen Beiträge
Datum
Titel
10.05.2024 07:04:14
nicht löschbar
09.05.2024 19:15:00
speichern über Makro ändert bedingt formatierte Zellen
09.05.2024 15:49:16
OEE Verlust als Linie an OEE
09.05.2024 13:10:18
Pivot-Tabelle mit Monaten und nicht Tagen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1936to1940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1936to1940
1936to1940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Spalten prüfen und kopieren

Spalten prüfen und kopieren
29.07.2023 19:48:36
oliver
Hallo zusammen,

Ich bräuchte mal wieder eure Hilfe

Ich habe zwei Tabellen in einer Datei.

Tabelle1 und Tabelle 2

in Tabelle 1 sind soll der Inhalt eine Zelle Spaltenweise (A12:CA12) geprüft werden. Wenn der Zelleninhalt ungleich 0 ist soll dieser Zelleinhalt und der Inhalt der nächsten 8 darunter liegenden Zellen kopiert werden. Also A12-A20.
Dann soll die nächste Spalte geprüft werden wenn ungleich 0 dann B12-B20 kopieren usw.

Das Kopierte soll dann in eine neue Tabelle kopiert werden dort muss der kopierte Inhalt aber Zeilenweise eingefügt werden.



Vielleicht kann mir ja jemand helfen.

Besten dank
Und Gruß Olli

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten prüfen und kopieren
30.07.2023 23:57:32
GerdL
Soso es wird auch transponiert.
Blattnamen in Anführungs- u. Schlußzeichen setzen, dagegen Codenamen der Tabelle ohne u. ohne Auflistung;
Argumente zeichengenau schreiben. 
Sub Unit()

    Dim i As Long, a As Long

    With Tabelle1

        For i = 1 To .Cells(18, .Columns.Count).End(xlToLeft).Column

             If .Cells(18, i) > 0 Then

                Call .Range(.Cells(19, i), .Cells(25, i)).Copy

                Call Tabelle2.Cells(1, 1).Offset(a, 0).PasteSpecial(Paste:=xlPasteValuesAndNumberFormats, Transpose:=True)

                Call Tabelle2.Cells(1, 1).Offset(a, 0).PasteSpecial(Paste:=xlPasteFormats, Transpose:=True)

                Application.CutCopyMode = False

                a = a + 1

            End If

        Next

    End With

End Sub

Gruß Gerd
Anzeige
AW: Spalten prüfen und kopieren
31.07.2023 08:49:56
oliver
Morgen Gerd,

danke es funktioniert.

AW: Spalten prüfen und kopieren
29.07.2023 20:24:31
GerdL
Moin,

leer ist hier > 0. 
Sub Unit()



    With Tabelle1

        .Range("CB12") = 0

        Call Intersect(.Range("A12:CB12").RowDifferences(Comparison:= _

            .Range("CB12")), .Rows("12:20")).Copy(Destination:=Tabelle2.Cells(1, 1))

        Call .Range("CB12").ClearContents

    End With



End Sub

Gruß Gerd
AW: Spalten prüfen und kopieren
29.07.2023 21:28:56
oliver
Hallo Gerd,

danke für deine Antwort.

Leider bekomme ich eine Fehlermeldung.

Er sagt Objekt erforderlich.

Habe mal ein Muster der Excel angefügt.

Grus u

Userbild
Anzeige
AW: Spalten prüfen und kopieren
29.07.2023 21:50:22
GerdL
Hallo Oliver,
nächster Versuch. 


Sub Unit2()



Dim tab1 As Worksheet, tab2 As Worksheet, zellen As Range, bereich As Range



Set tab1 = ThisWorkbook.Worksheets("Tabelle1")

Set tab2 = ThisWorkbook.Worksheets("Tabelle2")



tab1.Range("CB12") = 0



Set zellen = tab1.Range("A12:CB12").RowDifferences(Comparison:=tab1.Range("CB12"))



Set bereich = Intersect(zellen.EntireColumn, tab1.Rows("12:20"))



bereich.Copy tab2.Cells(1, 1)



End Sub

Gruß Gerd
AW: Spalten prüfen und kopieren
29.07.2023 23:04:51
oliver
Hallo Gerd,

danke das hat soweit funktioniert.
Leider kopiert er 1:1 ich brauche aber eine Transponierung also Spalten in Zeilen.

Eine Abfrage ob Zelleninhalt >0 ist funktioniert leider auch nicht.

Anzeige
AW: Spalten prüfen und kopieren
30.07.2023 08:09:14
RPP63
Moin!
Stelle mal eine Beispieldatei (kein Bild!) mit Wunschergebnis ein.
Mit Deinem Excel 365 kann ich mir gut vorstellen, das Ganze mittels Formel zu lösen.
MTRANS(FILTER())

Gruß Ralf
AW: Spalten prüfen und kopieren
30.07.2023 10:50:30
oliver
Hallo Ralf,

habe eine Bsp. Datei angefügt.
in Tabelle 1 können noch weitere Zeilen die kopiert werden sollen hinzu kommen. Auch die Zeile in gelb kann sich weiter nach unten schieben wenn oben mehrere Zeilen hinzu kommt. Man müsste also ein zeichen suchen und dann ab der nächsten Zeile das kopieren starten wenn gelbe Zelle >0 ist.

https://www.herber.de/bbs/user/162102.xlsx


Gruß Olli
Anzeige
Formel
30.07.2023 11:15:58
RPP63 
=MTRANS(FILTER(Tabelle1!A20:L25;Tabelle1!A18:L18>0))

Gruß Ralf
AW: Formel
30.07.2023 12:46:07
Oliver
Hi Ralf,

danke für die Formel,

aber wo erfolgt die Abfrage usw.?
Wo das kopieren in ein neues Tabellenblatt?
AW: Formel
30.07.2023 22:41:29
oliver
Hallo zusammen,

hab es mit diesem Code probiert. Leider funzt das nicht so richtig. Bekomme einen Laufzeitfehler 13.
Hat jemand eine Idee?

gruß Olli

Private Sub CommandButton1_Click()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 5
For i = 1 To 12
With Worksheets("Tabelle1")
If .Cells(18, i) > "0" Then
.Rows(i).Copy
Worksheets(Tabelle4).Rows(a).PasteSpecial Paste:=XlPasteValuesAndNumberFormtas
Worksheets(Tabelle4).Rows(a).PasteSpecial Paste:=xlPasteFormats
a = a + 1
End If
End With
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
Anzeige

Links zu Excel-Dialogen

CommandButton Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige