Thema Datum  Von Nutzer Rating
Antwort
11.12.2017 08:49:14 Wannadu
NotSolved
Blau Copy - Paste - Voraussetzung - mehrere Arbeitsblätter
 11.12.2017 11:19:55 Gast95069
Solved

Ansicht des Beitrags:
Von:
Gast95069		 Datum:
11.12.2017 11:19:55		 Views:
503		 Rating:
     
Antwort:
 Nein
Thema:
Copy - Paste - Voraussetzung - mehrere Arbeitsblätter		 
Option Explicit

Dim WsZiel As Worksheet, WsNum As Worksheet

Sub Zeilen()
Dim rngU As Range, c As Range, rngZ As Range
Dim FA As String, lrow As Long

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Application.EnableEvents = False
   Application.Calculation = xlCalculationManual
   
   Set WsZiel = IsKopie
   With WsZiel
      On Error Resume Next
      lrow = 1
      lrow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row + 1
      On Error GoTo 0
   End With
   
   For Each WsNum In Sheets
      If IsNumeric(WsNum.Name) Then
         Set rngU = WsNum.UsedRange
         With rngU
            Set c = .Find("Qualität", LookIn:=xlValues, LookAt:=xlPart)
            If Not c Is Nothing Then
               FA = c.Address
               Do
                  c.EntireRow.Copy WsZiel.Cells(lrow, 1)
                  lrow = lrow + 1
                  Set c = .FindNext(c)
               Loop While Not c Is Nothing And c.Address <> FA
            End If
         End With
      End If
   Next WsNum
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   
End Sub

Private Function IsKopie() As Worksheet
Dim wskopie As Worksheet
On Error Resume Next
   Sheets("Kopie").Activate
   If Err.Number > 0 Then
      Sheets.Add Before:=Sheets(1)
      ActiveSheet.Name = "Kopie"
   End If
On Error GoTo 0
   
   Set IsKopie = ActiveSheet

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
11.12.2017 08:49:14 Wannadu
NotSolved
Blau Copy - Paste - Voraussetzung - mehrere Arbeitsblätter
 11.12.2017 11:19:55 Gast95069
Solved