Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1404to1408
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
Inhaltsverzeichnis

Daten transportieren

Daten transportieren
27.01.2015 17:51:59
Dieter.G
Hallo zusammen,
ich brächte wieder mal Eure Hilfe.
Ich habe 12 Tabellenblätter (Tabelle21-Tabelle33) in den SpaltenD wird ein bestimmter "Text" eingegeben und in den SpaltenQ wird nur "ja" eingetragen. Jetzt möchte ich mit einem Makro sämtliche Tabellenblätter durchsuchen und immer wenn der "Text" und "ja" in einer Zeile vorhanden sind, die Daten aus den Nachbarzellen G, H, I, M, N der betreffenden Zeile in ein separates Tabellenblatt (Tabelle1) in die Spalten A, B, C, D, E transportiert lassen.
Danke schon mal im Voraus und Gruß
Dieter

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten transportieren
27.01.2015 18:47:43
Tino
Hallo,
ab welcher Zeile fangen die Daten an?
Ab welcher Zeile sollen die eingefügt werden?
Sollen alte gelöscht werden?
Gibt es sonst noch relevante Informationen?
Oder gibt es eine Musterdatei?
Gruß Tino

AW: Daten transportieren
27.01.2015 19:03:43
Dieter.G
Hallo Tino,
- Die Daten fangen ab Zeile 16 in SpalteQ an.
- Die Daten sollen am besten ab Zeile 2 eingefügt werden.
- Es sollen keine Daten gelöscht werden.
Es gibt leider keine Musterdatei!
Gruß Dieter

AW: Daten transportieren
27.01.2015 19:20:40
Tino
Hallo,
Es sollen keine Daten gelöscht werden.
Verstehe ich dich richtig?
Wenn Du 100mal den Code ausführst, hast du 100 mal die gleichen Daten in der Tabelle1!
Gruß Tino

Anzeige
AW: Daten transportieren
27.01.2015 19:40:40
Dieter.G
Hallo,
nein es sollen keine Daten gelöscht werden, die Daten die transportiert werden bestehen aus Namen und Telefonnummern. Es kann nichts doppelt vorhanden sein.
Gruß Dieter

AW: Daten transportieren
27.01.2015 20:27:10
Tino
Hallo,
ok. versuch es mal hiermit
Sub Kopieren()
Dim i%
Dim lngRow&
Dim rng As Range, rngErg As Range, rngHelp As Range

For i = 21 To 33
    With Worksheets("Tabelle" & i)
        lngRow = .Cells(.Rows.Count, 17).End(xlUp).Row
        If lngRow > 15 Then
            'Daten Suchen ******************** 
            Set rng = .Range("A16", .Cells(lngRow, 1)).EntireRow
            Set rngHelp = rng.Columns(.Columns.Count)
            rngHelp.FormulaR1C1 = "=IF(AND(RC4<>"""",RC17=""ja""),1,"""")"
            If Application.WorksheetFunction.CountIf(rngHelp, 1) > 0 Then
                Set rngErg = rngHelp.SpecialCells(xlCellTypeFormulas, 1)
            End If
            
            
            'Ausgabe ************************** 
            If Not rngErg Is Nothing Then
                With Tabelle1
                    For Each rngErg In rngErg.Areas
                        With .Cells(.Rows.Count, 4).End(xlUp).Offset(1, -3)
                            rngErg.EntireRow.Columns(7).Resize(, 3).Copy .Resize(, 4)
                            rngErg.EntireRow.Columns(12).Resize(, 2).Copy .Offset(, 3).Resize(, 2)
                        End With
                    Next rngErg
                End With
                rngHelp.EntireColumn.Delete
                Set rngErg = Nothing
            End If
        End If
    End With
Next i
End Sub
Gruß Tino

Anzeige
AW: Daten transportieren
27.01.2015 20:43:14
Dieter.G
Hallo Tino,
das klappt leider nicht. In der Zeile "With Worksheets("Tabelle" & i)" bekomme ich die Fehlermeldung Index außerhalb des gültigen Bereichs.
Gruß Dieter

dann fehlen Tabellen zwischen Tabelle21 u. 33 oT.
27.01.2015 20:50:38
Tino

AW: Daten transportieren
27.01.2015 21:01:25
Dieter.G
Hallo Tino,
bei den Tabellennamen handelt es sich um die Namen aus der "Entwicklerumgebung" und die lauten Tabelle21 - Tabelle33. Die Tabellenreiter im Excel Sheet haben andere Namen. Es sind 12 Tabellenblätter für ein ganzes Jahr. Vielleicht liegt es ja daran?
Gruß Dieter

ja daran liegt es
27.01.2015 21:15:43
Tino
Hallo,
das sind relevante Informationen!
Mach eine Schleife über alle Tabellen und prüfe auf den Codename.
Gruß Tino

Anzeige
AW: Daten transportieren
27.01.2015 21:29:18
Dieter.G
Hallo Tino,
leider weiß ich nicht wie das funktioniert.
Gruß D.

AW: Daten transportieren
27.01.2015 22:45:35
Tino
Hallo,
könnte so gehen.
PS: Warum antwortest du eigentlich immer auf Deinen letzten Beitrag?
Sub Kopieren()
Dim i%
Dim lngRow&
Dim rng As Range, rngErg As Range, rngHelp As Range
Dim oWS As Worksheet

For i = 21 To 23
    For Each oWS In ThisWorkbook.Worksheets
        If oWS.CodeName = "Tabelle" & i Then
            With oWS
                lngRow = .Cells(.Rows.Count, 17).End(xlUp).Row
                If lngRow > 15 Then
                    'Daten Suchen ******************** 
                    Set rng = .Range("A16", .Cells(lngRow, 1)).EntireRow
                    Set rngHelp = rng.Columns(.Columns.Count)
                    rngHelp.FormulaR1C1 = "=IF(AND(RC4<>"""",RC17=""ja""),1,"""")"
                    If Application.WorksheetFunction.CountIf(rngHelp, 1) > 0 Then
                        Set rngErg = rngHelp.SpecialCells(xlCellTypeFormulas, 1)
                    End If
                    
                    
                    'Ausgabe ************************** 
                    If Not rngErg Is Nothing Then
                        With Tabelle1
                            For Each rngErg In rngErg.Areas
                                With .Cells(.Rows.Count, 4).End(xlUp).Offset(1, -3)
                                    rngErg.EntireRow.Columns(7).Resize(, 3).Copy .Resize(, 4)
                                    rngErg.EntireRow.Columns(12).Resize(, 2).Copy .Offset(, 3).Resize(, 2)
                                End With
                            Next rngErg
                        End With
                        rngHelp.EntireColumn.Delete
                        Set rngErg = Nothing
                    End If
                End If
            End With
        End If
    Next oWS
Next i
End Sub
Gruß Tino

Anzeige
mach noch aus 23 beser 33 oT.
27.01.2015 22:47:16
Tino

AW: mach noch aus 23 beser 33 oT.
27.01.2015 23:27:08
Dieter.G
Hallo Tino,
das will immer noch nicht so richtig funktionieren!
Trotzdem Vielen Dank für Deine Mühe!
Gruß Dieter

bei mir geht es...
27.01.2015 23:58:09
Tino
Hallo,
weiß nicht was bei dir anders ist.
Beispieldatei hochladen hilft.
Gruß Tino

AW: bei mir geht es...
28.01.2015 06:06:23
Dieter.G
Hallo,
die Fehlermeldung ist jetzt weg. Das Problem ist, es wird immer wieder gefragt, "Sollen die Inhalte der Zellen des Zellbereiches überschrieben werden?". Am Ende bleiben ca. 20 Zeilen übrig, es sollten aber ca. 140 Zeilen übrigbleiben. Könnte man die Tabelle nicht von unten mit den Daten auffüllen? Ich hoffe es liegt nicht an den Leerzeilen in den Tabellenblättern!?
Ich versuch mal eine Beispieldatei zu erstellen, kann das Original wg. Datenschutz nicht hochladen.
Danke und Gruß
Dieter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige