Εμφάνιση ενός μόνο μηνύματος
  #3  
Παλιά 16-11-19, 17:08
caudillo Ο χρήστης caudillo δεν είναι συνδεδεμένος
Όνομα: Κώστας
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 16-03-2015
Μηνύματα: 151
Προεπιλογή

Καλησπέρα σε όλο το forum,
συνεχίζοντας το ψάξιμο στο internet, μήπως καταφέρω να φτιάξω το excel μου όπως το θέλω, βρήκα τον παρακάτω κώδικα:
Παράθεση:
'In a Standard Module

Option Explicit
Function FilterAndCopy(rng As Range, Choice As String)

Dim FiltRng As Range
'Clear Contents to show just new search data
Worksheets("Sheet2").Cells.ClearContents
'Set the column to filter (In This Case 1 or A)
'Change as required
rng.AutoFilter Field:=1, Criteria1:=Choice
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0

'Copy Data across to sheet 2
FiltRng.Copy Worksheets("Sheet2").Range("A1")
'Display Data
Worksheets("Sheet2").Select
Range("A1").Select
Set FiltRng = Nothing
End Function

Sub formshow()
'Show Search Form
UserForm1.Show
End Sub

'************************************************* ****************
'In a userform

Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range

'Set Error Handling
On Error GoTo ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
'Cancel if no value entered in textbox
If TextBox1.Value = "" Then GoTo ws_exit:
'Call function Filterandcopy
FilterAndCopy rng, TextBox1.Value
rng.AutoFilter
'Exit sub
ws_exit:
Set rng = Nothing
Application.EnableEvents = True
Unload Me
End Sub

Private Sub CommandButton2_Click()
'Cancel Button
Unload Me
End Sub
Βέβαια πιστεύω πως χρειάζεται διορθώσεις για να ταιριάξει με το αρχείο μου, τις οποίες όμως δεν γνωρίζω.
Εδώ έρχεται η δική σας βοήθεια, εφόσον θέλει κάποιος να ασχοληθεί.
Το ίδιο ισχύει για ένα έτοιμο αρχείο Excel που βρήκα πάλι στο internet. Έχει ένα κουμπί αναζήτησης, αλλά πάλι χρειάζεται προσαρμογή στο δικό μου αρχείο ο κώδικάς του. Άρα ξαναγυρνάω στη δίκη σας βοήθεια.
Ευχαριστώ, θα περιμένω νέα σας.
Συνημμένα Αρχεία
Τύπος Αρχείου: xls copy and paste using filter.xls (172,5 KB, 23 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη caudillo : 16-11-19 στις 17:36.
Απάντηση με παράθεση