Thema Datum  Von Nutzer Rating
Antwort
03.06.2020 10:37:33 Nopsi
NotSolved
03.06.2020 12:59:38 Gast63871
NotSolved
03.06.2020 13:51:31 Gast58614
NotSolved
03.06.2020 14:07:00 Gast63871
NotSolved
03.06.2020 15:02:51 Nopsi
NotSolved
03.06.2020 15:08:34 Gast63871
NotSolved
04.06.2020 07:26:25 Nopsi
NotSolved
04.06.2020 08:00:29 Nopsi
NotSolved
04.06.2020 08:35:50 Gast87673
NotSolved
04.06.2020 09:29:05 Nopsi
NotSolved
Rot Versuch mal obs passt:
 04.06.2020 12:59:34 Gast63871
NotSolved
04.06.2020 13:34:47 Nopsi
NotSolved
04.06.2020 13:55:53 Gast63871
Solved

Ansicht des Beitrags:
Von:
Gast63871		 Datum:
04.06.2020 12:59:34		 Views:
660		 Rating:
     
Antwort:
  Ja
Thema:
Versuch mal obs passt:

Option Explicit


Sub main()
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rngQuelle As Excel.Range
    Dim rngToCopy As Excel.Range
    Dim sTxt As String
    
    Set wks = ThisWorkbook.Worksheets(1)                                    '<<<--- Makro wirkt auf in dieser Arbeitsmappe auf Tabellenblatt 1
    Set wkb = Application.Workbooks("Errechnung Dehnung_Schrumpfung.xls")   '<<<---- die Mappe muss bereits geöffnet sein
     
    sTxt = InputBox("Teilenummer:")
         
        If sTxt = "" Then Exit Sub
         
            With wks
                 
                If .AutoFilterMode Then .AutoFilterMode = False
                     
                    Set rngQuelle = .Range("A1").CurrentRegion
                        rngQuelle.AutoFilter Field:=3, Criteria1:=sTxt
                    
                    Set rngQuelle = Intersect( _
                                                rngQuelle, _
                                                rngQuelle.SpecialCells(xlCellTypeVisible), _
                                                rngQuelle.Columns("A:C"))
                                                
                    If Not rngQuelle Is Nothing Then
                        With rngQuelle
                            .Copy Destination:=wkb.Worksheets(1).Range("E7") '<<<--- Worksheets(1) bewirkt das Kopieren in das erste Arbeitsblatt; alle sichtabren in den Spalten A,B,C
                        End With
                    End If
                         
            End With
            
            
            
            
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
03.06.2020 10:37:33 Nopsi
NotSolved
03.06.2020 12:59:38 Gast63871
NotSolved
03.06.2020 13:51:31 Gast58614
NotSolved
03.06.2020 14:07:00 Gast63871
NotSolved
03.06.2020 15:02:51 Nopsi
NotSolved
03.06.2020 15:08:34 Gast63871
NotSolved
04.06.2020 07:26:25 Nopsi
NotSolved
04.06.2020 08:00:29 Nopsi
NotSolved
04.06.2020 08:35:50 Gast87673
NotSolved
04.06.2020 09:29:05 Nopsi
NotSolved
Rot Versuch mal obs passt:
 04.06.2020 12:59:34 Gast63871
NotSolved
04.06.2020 13:34:47 Nopsi
NotSolved
04.06.2020 13:55:53 Gast63871
Solved