Microsoft Excel

Herbers Excel/VBA-Archiv

Zeile suchen Wert kopieren, einfügen | Herbers Excel-Forum


Betrifft: Zeile suchen Wert kopieren, einfügen von: MarkusB.
Geschrieben am: 22.01.2010 14:02:33

Hallo allerseits!
Bei meinem letzen Problem hat mir Rudi wirklich super weitergeholfen!
Jetzt bin ich an einem Code dran, wo ich nicht weiter weiß:

Es soll der Fett markierte Bereich: wks.Range(wks.Cells(test, test)).Select, also die komplette ZEILE
durchsucht werden nach einer Zelle, die eine Anzahl von 10 Zeichen (Zahlen) hat z.B. 2300054123 (die Zahl fängt auch immer mit 2 an). Die soll dann kopiert werden und die Zelle danach: Bsp.: Zahl steht in Spalte P3 soll P3 und Q3 kopiert werden und dann auf dem 1.Arbeitsblatt in eine festgelegten Spaltenbereich (z. B.: immer L, M) eingefügt werden...

Kann mir da jemand weiterhelfen??
Danke + Gruß
Markus

Bisheriger Code:

Sub Schaltfläche2_KlickenSieAuf()
    
    Dim n As Integer, i As Integer, test, wks As Worksheet
    Application.ScreenUpdating = False
    With Sheets(1)
      For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row
        For n = 2 To Worksheets.Count
          Set wks = Worksheets(n)
          test = Application.Match(.Cells(i, 3), wks.Columns(3), 0)
          If Not IsError(test) Then
            wks.Range(wks.Cells(test, 1), wks.Cells(test, 4)).Copy
            Cells(i, 1).Select
            'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone,  _
SkipBlanks:=False, Transpose:=False

            wks.Range(wks.Cells(test, test)).Select
 .... weiß nicht weiter.....
            
            Exit For
          End If
          End If
        Next n
      Next i
    End With
    Application.ScreenUpdating = True
  End Sub

  

Betrifft: AW: Zeile suchen Wert kopieren, einfügen von: JOWE
Geschrieben am: 22.01.2010 18:00:00

Hallo Markus,

probier mal dies hier:

Sub jupp()
    Dim zaehler, zeile As Integer
    Dim z As Object
    zeile = ActiveCell.Row
    For Each z In _
      Sheets(2).Range(Sheets(2).Cells(zeile, 1), _
      Sheets(2).Cells(zeile, 255))
      If Len(z.Value) = 10 Then
        zaehler = zaehler + 1
        z.Copy Destination:=Sheets(1).Range("L" & zaehler)
        Sheets(2).Cells(z.Row, z.Column + 1).Copy _
        Destination:=Sheets(1).Range("M" & zaehler)
      End If
    Next
End Sub

Gruß
Jochen


  

Betrifft: DANKE JOWE von: MarkusB.
Geschrieben am: 23.01.2010 00:07:41

Hi Jochen,

du bist spitze!!! :-)
Vielen Dank, hast mir wirklich sehr weitergeholfen!
Deinen Code kann ich sehr gut verwenden...
werde meinen fertigen Code dann hier reinstellen...

Nochmals vielen Dank und schönes Wochenende!!!!

Viele Grüße
Markus


Beiträge aus den Excel-Beispielen zum Thema "Zeile suchen Wert kopieren, einfügen"