Χρειάζομαι βοήθεια! Προσπαθώ να δημιουργήσω ένα φύλλο εργασίας για να βοηθήσω στη δουλειά, εκτός από το ότι δεν είμαι πραγματικά γνώστης υπολογιστή. Χρησιμοποίησα έναν υπάρχοντα κώδικα που ήταν μαγικός εκτός από ένα μικρό tweek που δεν φαίνεται να μπορώ να επεξεργαστώ με επιτυχία. Πρέπει να μετακινήσω δεδομένα από μια επιλογή στο Φύλλο 1 με βάση μια τιμή στο Φύλλο 2. Χρειάζομαι τον κωδικό για διαγραφή εντός ενός συγκεκριμένου εύρους και όχι ολόκληρης της σειράς. Έχω άλλα δεδομένα στη σειρά που δεν θέλω να διαγραφούν. Ονόμασα την περιοχή στο Φύλλο 1 σε "ΕΠΑΝΑΦΟΡΑ" (=Sheet1!$A$15:$F$54) ελπίζοντας ότι θα μπορούσα να ενσωματώσω το όνομα στον κώδικα. Δεν ξέρω πώς να αλλάξω τον κωδικό για να μετακινήσω και να διαγράψω πληροφορίες εντός του ονομαζόμενου εύρους "ΑΠΟΚΑΤΑΣΤΑΣΗ". Αυτός είναι ο αρχικός κώδικας που πρέπει να επεξεργαστώ:

Sub

Cheezy()

'Updated by Kutools for Excel 2017/8/28

Dim

xRg 

As

Range

Dim

xCell 

As

Range

Dim

I 

As

Long

Dim

J 

As

Long

Dim

K 

As

Long

I = Worksheets(

"Sheet1"

).UsedRange.Rows.Count

J = Worksheets(

"Sheet2"

).UsedRange.Rows.Count

If

J = 1 

Then

If

Application.WorksheetFunction.CountA(Worksheets(

"Sheet2"

).UsedRange) = 0 

Then

J = 0

End

If

Set

xRg = Worksheets(

"Sheet1"

).Range(

"C1:C"

& I)

On

Error

Resume

Next

Application.ScreenUpdating = 

False

For

K = 1 

To

xRg.Count

If

CStr

(xRg(K).Value) = 

"Done"

Then

xRg(K).EntireRow.Copy Destination:=Worksheets(

"Sheet2"

).Range(

"A"

& J + 1)

xRg(K).EntireRow.Delete

If

CStr

(xRg(K).Value) = 

"Done"

Then

K = K - 1

End

If

J = J + 1

End

If

Next

Application.ScreenUpdating = 

True

End

Sub