Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen auslesen und in neues Tabellenblatt importieren
29.09.2021 09:58:46 sek257
NotSolved
29.09.2021 11:19:41 Nobody
****
Solved
30.09.2021 07:38:36 sek257
NotSolved

Ansicht des Beitrags:
Von:
sek257
Datum:
29.09.2021 09:58:46
Views:
125
Rating: Antwort:
  Ja
Thema:
Zellen auslesen und in neues Tabellenblatt importieren

Hallo,
ich habe ein kleines Problem und komme nicht weiter.
Ich habe eine Excel-Tabelle (Excel1) in der ich im Tabellenblatt 1 ("Auslesen") ein Eingabefeld habe sowie einen Button zum Start meines Makros. 

Gebe ich nichts ein, öffnet das Makro eine Quelldatei (Excel2) und kopiert alle Zeilen in das Tabellenblatt 1 meiner Excel1. Schreibe ich in das Eingabefeld eine Zahl, werden nur die Zeilen kopiert und eingefügt, in denen die gesuchte Zahl auch vorhanden ist. Nach dem kopieren und einfügen wird die Quelldatei (Excel2) wieder automatisch geschlossen. 

Jetzt möchte ich aber, dass die kopierten Zeilen nicht im Tabellenblatt1 von Excel1 eingefügt werden, sondern es soll in Excel1 zunächst ein weiteres Tabellenblatt (Tabellenblatt2) erstellt und dort eingefügt werden. Alles was ich bisher versucht habe, hat leider nicht geklappt. 

Kann mir jemand helfen? 
Nachfolgend findet ihr meinen bisherigen Code



Sub Daten_suchen()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, cell As Object
Dim str_quelldatei As Workbook
Dim str_quellblatt As Worksheet
Dim lng_zeile As Long
Dim lng_ziel_zeile As Long
Dim suchbegriff As String
Dim suchbegriff1 As String

suchbegriff = ThisWorkbook.Sheets("Auslesen").Cells(5, 4).Value
suchbegriff1 = suchbegriff & " "

pfad = "C:\Users\Max\Desktop\"
datei = "Excel2.xlsx"
blatt = "Tabelle1"

'** Wenn bereits nach Daten gesucht wurde, alte Suche löschen
Range("B8:F1000").ClearContents

'** Pop-Up wenn keine Daten in Suchfeld eingegeben wurde
If suchbegriff = "" Then
    answer = MsgBox("Es wurde keine Daten eingegeben." & vbNewLine & "Möchten Sie trotzdem suchen?", vbQuestion + vbYesNo + vbDefaultButton2, "Suche")
    If answer = vbNo Then
        End
    End If

    '** Bereich in Quelldatei der ausgelesen werden soll
    Set bereich = Range("B9:F1000")

    '** Bereich auslesen
    For Each cell In bereich

      '** Zellen umwandeln
      cell = cell.Address(False, False)

      '** Eintragen in Bereich
      ActiveSheet.Cells(cell.Row, cell.Column).Value = GetValue(pfad, datei, blatt, cell)
    Next cell
Else
    ' Suche nach eingegebenen Daten
    Set str_quelldatei = Workbooks.Open(pfad & datei)
    Set str_quellblatt = str_quelldatei.Worksheets(blatt)
    lng_zeile = 9
    lng_ziel_zeile = 9
    With str_quellblatt
        Do Until .Cells(lng_zeile, 2) = ""
            If .Cells(lng_zeile, 5) = suchbegriff1 Then
                .Range(.Cells(lng_zeile, 2), .Cells(lng_zeile, 6)).Copy _
                    ThisWorkbook.Worksheets("Auslesen").Cells(lng_ziel_zeile, 2)
                lng_ziel_zeile = lng_ziel_zeile + 1
            End If
            lng_zeile = lng_zeile + 1
        Loop
    End With
    str_quelldatei.Close savechanges:=False
End If

End Sub

Private Function GetValue(pfad, datei, blatt, cell)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass die Datei vorhanden ist
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "Datei nicht gefunden"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(cell).Range("A1").Address(, , xlR1C1)

GetValue = ExecuteExcel4Macro(arg)

End Function



Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Zellen auslesen und in neues Tabellenblatt importieren
29.09.2021 09:58:46 sek257
NotSolved
29.09.2021 11:19:41 Nobody
****
Solved
30.09.2021 07:38:36 sek257
NotSolved