Zum Inhalt springen

Bestimmte "Zeilen auslesen " excel Tabelle


Greenhardy

Empfohlene Beiträge

Gibt es keine Möglichkeit. Das es sich die Zeilen durchgeht und wenn das Programm eine Zeile Mit dem Wort type findet ,das es dann die Komplette Zeile in eine neue Datei schreibt. Und das wird solange gemacht bis es mit der Excel Datei duch ist. So in etwa bräucht ich es den Rest könnte ich dann selber bearbeiten. Weil die Lösung von dir ist nicht ganz die wo ich brauch oder versteh ich des bloß falsch?

Link zu diesem Kommentar
Auf anderen Seiten teilen

Hallo,

versuch das mal:


Sub Zeilen_kopieren()

'kopiert alle Zeilen in neue Mappe wenn

'in Spalte A "Typ" steht

Dim letzte_Zeile As Long, Zeile As Long, Treffer As Long

Dim wkb_Neu As Workbook


Set wkb_Neu = Workbooks.Add


'letzte Zeile Spalte A

letzte_Zeile = Cells(Rows.Count, 1).End(xlUp).Row


For Zeile = 1 To letzte_Zeile


  If Cells(Zeile, 1) = "Typ" Then

    Treffer = Treffer + 1

    Rows(Zeile).Copy wkb_Neu.Worksheets("Tabelle1").Cells(Treffer, 1)

  End If


Next Zeile


Set wkb_Neu = Nothing

MsgBox Treffer & " Zeilen kopiert", , ""


End Sub

Gruß

Alfons

-------------------------

meine Excelseiten: Excel-Dateien und VBA für Excel

-------------------------

Link zu diesem Kommentar
Auf anderen Seiten teilen

und wo genau liegt das Problem? Fehlermeldung? Excelversion?

den folgenden Code kannst Du auch in ein normales Modul packen.

Die zu durchsuchende Tabelle muss dann aber die aktive sein!


Sub Modulaufruf_Zeilen_kopieren_2()

'kopiert alle Zeilen in neue Mappe wenn

'in Spalte A "Typ" steht

Dim letzte_Zeile As Long, Zeile As Long, Treffer As Long

Dim wkb_Neu As Workbook

Dim wks As Worksheet


Set wks = ThisWorkbook.ActiveSheet

'letzte Zeile mit Inhalt Spalte A

letzte_Zeile = wks.Cells(Rows.Count, 1).End(xlUp).Row


Set wkb_Neu = Workbooks.Add


For Zeile = 1 To letzte_Zeile


  If wks.Cells(Zeile, 1) = "Typ" Then

    Treffer = Treffer + 1

    wks.Rows(Zeile).Copy wkb_Neu.Worksheets("Tabelle1").Cells(Treffer, 1)

  End If


Next Zeile


Set wks = Nothing

Set wkb_Neu = Nothing

MsgBox Treffer & " Zeilen kopiert", , ""


End Sub

Gruß

Alfons

-------------------------

meine Excelseiten: Excel-Dateien und VBA für Excel

-------------------------

Link zu diesem Kommentar
Auf anderen Seiten teilen

Vielen dank für den code. Des war ein Fehler meiner Seite. Deine Seite ist auch sehr Interessant. Vielen dank :)

Aber Interessant wäre es noch zu wissen wie ich das Ganz geschickt auf eine Arbeitsmappe anwende?

Hast du da vielleicht tipps?

Bearbeitet von Greenhardy
Link zu diesem Kommentar
Auf anderen Seiten teilen

ist nicht schön aber fluppt für alle Tabellen:


Sub Modulaufruf_Zeilen_kopieren_alle_Tabellen()

'kopiert alle Zeilen in neue Mappe wenn

'in Spalte A "Typ" steht

Dim letzte_Zeile As Long, Zeile As Long, Treffer As Long

Dim wkb_Neu As Workbook

Dim wks As Worksheet


Set wkb_Neu = Workbooks.Add


For Each wks In ThisWorkbook.Worksheets

  wks.Activate

  'letzte Zeile mit Inhalt Spalte A

  letzte_Zeile = wks.Cells(Rows.Count, 1).End(xlUp).Row


  For Zeile = 1 To letzte_Zeile

    If wks.Cells(Zeile, 1).Value = "Typ" Then

      Treffer = Treffer + 1

      wks.Rows(Zeile).Copy wkb_Neu.Worksheets("Tabelle1").Cells(Treffer, 1)

    End If

  Next Zeile

Next wks


wkb_Neu.Activate

Set wkb_Neu = Nothing

MsgBox Treffer & " Zeilen kopiert", , ""


End Sub

Gruß

Alfons

-------------------------

meine Excelseiten: Excel-Dateien und VBA für Excel

-------------------------

Link zu diesem Kommentar
Auf anderen Seiten teilen

Hab doch nochmal eine Frage. Es werden bis jetzt die Zeilen Typ rausgeschrieben in eine neue Excel Tabelle. Doch nun wollt ich noch wissen. Unter der Typ Zeile kommt eine Baujahr spalte. Wie kann ich es lösen das es mir immer jeweils Typ und dan Baujjahr in die Neue Excel Tabelle schreibt also Typ, Bauhjjahr, Typ, Bauhjjahr,... ? Hab schon einiges ausprobiert aber kriegt des nur so hin das es mit Typ in eine Excel Tabelle schreibt und Baujjahr in eine neue.

gruß

Link zu diesem Kommentar
Auf anderen Seiten teilen

da steht aber nichts von Baujahr: ImageShack - Hosting :: screenhunter06jun251512bh1.jpg


Sub Modulaufruf_Zeilen_kopieren_alle_Tabellen()

'kopiert immer zwei Zeilen

Dim letzte_Zeile As Long, Zeile As Long, Treffer As Long

Dim wkb_Neu As Workbook

Dim wks As Worksheet

Dim Antwort As Integer


Antwort = MsgBox("Ab jetzt werde ich meine Fragen genauer formulieren", vbYesNo, "")


If Antwort = 7 Then

  Exit Sub

End If


Set wkb_Neu = Workbooks.Add


Treffer = 1

For Each wks In ThisWorkbook.Worksheets

  wks.Activate

  'letzte Zeile mit Inhalt Spalte A

  letzte_Zeile = wks.Cells(Rows.Count, 1).End(xlUp).Row


  For Zeile = 1 To letzte_Zeile

    If wks.Cells(Zeile, 1).Value = "Typ" Then

      'wks.Rows(Zeile).Copy wkb_Neu.Worksheets("Tabelle1").Cells(Treffer, 1)

      wks.Range(Cells(Zeile, 1), Cells(Zeile + 1, Columns.Count)).Copy _

        wkb_Neu.Worksheets("Tabelle1").Cells(Treffer, 1)

      Treffer = Treffer + 2

    End If

  Next Zeile

Next wks


wkb_Neu.Activate

Set wkb_Neu = Nothing

MsgBox Treffer - 1 & " Zeilen kopiert", , ""


End Sub

Gruß

Alfons

-------------------------

meine Excelseiten: Excel-Dateien und VBA für Excel

-------------------------

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...