Thema Datum  Von Nutzer Rating
Antwort
Rot statt .EntireRow festen Bereich kopieren
11.07.2021 13:03:57 Fabian
NotSolved
11.07.2021 13:47:35 ralf_b
Solved
11.07.2021 14:09:23 ralf_b
Solved

Ansicht des Beitrags:
Von:
Fabian
Datum:
11.07.2021 13:03:57
Views:
58
Rating: Antwort:
  Ja
Thema:
statt .EntireRow festen Bereich kopieren

Hallo zusammen,

kann mir bitte jemand meinen Code so abändern, dass nicht die ganze Zeile in Eingabe kopiert wird, sondern nur die Zellen A-J der jeweils gesuchten Zeile?

Ich vermute das Problem ist diese Zeile oder?

    rBereich.EntireRow.Copy WSh.Cells(iZeile, "A").EntireRow

anbei mein verwendeter Code:

Dim rBereich As Range
  Dim sIchsuche As String, sErsteAdresse As String
  Dim sBer As String, sArr() As String
  Dim WSh As Worksheet, iZeile As Long, i As Long, iGefunden As Long
  Dim bCheck As Boolean

  sIchsuche = TextBox1
  If StrPtr(sIchsuche) = 0 Then Exit Sub
  If sIchsuche = "" Then
     MsgBox "Nix kon ma ned findn!", vbCritical, "Suche"
     Exit Sub
  End If

  Set WSh = Worksheets("Eingabe")
  WSh.Range("A8:J1000").Clear
 


With Worksheets("Bestand").Range("A:J")
      sArr = Split(sIchsuche)
      Set rBereich = .Find(sArr(0), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
      If Not rBereich Is Nothing Then
         sErsteAdresse = rBereich.Address
         Do
            iZeile = WSh.Cells(Rows.Count, "A").End(xlUp).Row + 1
            If iZeile < 8 Then iZeile = 8
            bCheck = True
            If UBound(sArr) > 0 Then
               For i = 1 To UBound(sArr)
                   On Error Resume Next
                   sBer = rBereich.Row & ":" & rBereich.Row
                   If Application.WorksheetFunction.Match(sArr(i) & "*", .Range(sBer), 0) = 0 Then
                      bCheck = False: Exit For
                   End If
                  Next i
               On Error GoTo 0
            End If
            If bCheck Then
               rBereich.EntireRow.Copy WSh.Cells(iZeile, "A").EntireRow
            End If
            Set rBereich = .FindNext(rBereich)
         Loop While Not rBereich Is Nothing And rBereich.Address <> sErsteAdresse

      End If
  End With

 


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 statt .EntireRow festen Bereich kopieren
11.07.2021 13:03:57 Fabian
NotSolved
11.07.2021 13:47:35 ralf_b
Solved
11.07.2021 14:09:23 ralf_b
Solved