Thema Datum  Von Nutzer Rating
Antwort
23.09.2016 13:18:14 Nemo
NotSolved
Blau Makro code
 23.09.2016 16:27:05 Gast92581
NotSolved
26.09.2016 16:15:30 Gast13481
NotSolved
26.09.2016 16:15:33 Gast48266
NotSolved
26.09.2016 16:15:34 Gast55900
NotSolved

Ansicht des Beitrags:
Von:
Gast92581		 Datum:
23.09.2016 16:27:05		 Views:
717		 Rating:
     
Antwort:
  Ja
Thema:
Makro code

Auch Hallo!

Sub DoIt()
'Tabellennamen & Spaltennummern anpassen
Dim rngNum As Range, c As Range

With Sheets("Tabelle3")
   .Unprotect
   .Cells.Clear
End With
With Sheets("Tabelle1")
   'keine Überschriften
   'statt x Schaltflächen
   .Activate
   On Error Resume Next
   Set rngNum = Application.InputBox("Klicke auf Nummern-Zelle", "Zur Weiterverarbeitung", , , , , , 8)
   If Err.Number > 0 Then Exit Sub
   On Error GoTo 0
   If rngNum.Column <> 2 Or rngNum.Value = "" Or Not IsNumeric(rngNum.Value) Then Exit Sub
End With

With Sheets("Tabelle2")
   'keine Überschriften
   .Columns(2).AutoFilter Field:=1, Criteria1:=rngNum.Value
   .UsedRange.SpecialCells(12).Copy Sheets("Tabelle3").Cells(1)
   .Columns(2).AutoFilter
End With

With Sheets("Tabelle3")
   'keine Überschriften
   Do While .Cells(2).Value <> rngNum.Value
      .Cells(2).EntireRow.Delete
   Loop
   
   Set rngNum = .Cells(2).Offset(3)
   Do
      Range(rngNum.Offset(1, 0), rngNum.Offset(2, 0)).EntireRow.Insert
      Set rngNum = rngNum.Offset(3)
      If rngNum.Offset(1, 0) = "" Then Exit Do
   Loop
   .Cells.Locked = False
   .Columns("A:F").Locked = True
End With

Sheets("Tabelle3").Activate
End Sub

 

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
23.09.2016 13:18:14 Nemo
NotSolved
Blau Makro code
 23.09.2016 16:27:05 Gast92581
NotSolved
26.09.2016 16:15:30 Gast13481
NotSolved
26.09.2016 16:15:33 Gast48266
NotSolved
26.09.2016 16:15:34 Gast55900
NotSolved