پرسش انتقال مشروط یک سلول از یک شیت به شیت دیگر

[pmgnasiri]

سلام و خسته نباشید خدمت همه دوستان.
یه فایل اکسل دارم که بیش از 1600 تا شیت داره با تعداد ستون های ثابت اما تعداد سطرها در هر شیت متفاوته . میخوام از هر شیت تو آخرین سطری که ستون اولش دارای دیتاست ستونهای 22 و 23 رو چک کنه اگر buy یا sell بود در شیت اول همین فایل یک ستون ایجاد کنه و اسم شیت رو بنویسه و buy یا sell رو مقابلش قرار بده و شیت بعدی رو بررسی کنه و buy و sell بعدی رو در ستون اول شیت یک زیر قبلی قرار بده.
این کد رو نوشتم اما نمی دونم کجای کار اشتباهه لطفا راهنمایی کنید:

()Sub app1

Dim i As Integer
Dim lastcount As Integer
Dim sheet As Worksheet

i = 2
Sheet1.Columns(1).Insert

For Each sheet In Worksheets
lastcount = sheet.Cells(Rows.Count, 1).End(xlUp).Row

If sheet.Cells(lastcount, 22).Value = "BUY" Then
Sheet1.Cells(i, 1) = Sheets(i).Name
Sheet1.Cells(i, 2).Value = "BUY"
End If

If sheet.Cells(lastcount, 23).Value = "SELL" Then
Sheet1.Cells(i, 1) = Sheets(i).Name
Sheet1.Cells(i, 2).Value = "SELL"
End If

i = i + 1

Next sheet

End Sub

[iranweld]

با سلام

این کد را تست کنید

Sub app1()

Dim i As Integer
Dim lastcount As Integer
Dim sheet As Worksheet

i = 2
Sheet1.Columns(1).Insert

For Each sheet In Worksheets


lastcount1 = sheet.Cells(Rows.Count, 22).End(xlUp).Row
lastcount2 = sheet.Cells(Rows.Count, 23).End(xlUp).Row

If sheet.Cells(lastcount1, 22).Value = "BUY" Then
Sheet1.Cells(i, 1) = sheet.Name
Sheet1.Cells(i, 2).Value = "BUY"
i = i + 1
End If

If sheet.Cells(lastcount2, 23).Value = "SELL" Then
Sheet1.Cells(i, 1) = sheet.Name
Sheet1.Cells(i, 2).Value = "SELL"
i = i + 1
End If

Next sheet

End Sub 

[pmgnasiri]

با سلام . ممنونم از اینکه به سوالم پاسخ دادید.
از اونجا که در ستون های 22 و 23 ممکنه برای پیش بینی اعداد ستون ادامه داشته باشه آخرین سطر مورد قبول همون سطر ستون اول است. کد رو به این صورت تغییر دادم.
با کمک شما مشکل تا حدودی حل شد اما تا پایان ادامه پیدا نمی کنه.

()Sub app1

Dim i As Integer
Dim lastcount As Integer
Dim sheet As Worksheet
Dim number As Integer

i = 2

For Each sheet In Worksheets

lastcount = sheet.Cells(Rows.Count, 1).End(xlUp).Row

If sheet.Cells(lastcount, 22).Value = "BUY" Then
Sheet1.Cells(i, 1) = sheet.Name
"Sheet1.Cells(i, 2).Value = "BUY
i = i + 1
End If

If sheet.Cells(lastcount, 23).Value = "SELL" Then
Sheet1.Cells(i, 1) = sheet.Name
"Sheet1.Cells(i, 2).Value = "SELL
i = i + 1
End If

Next sheet

number = Sheets.Count

("پس از بررسي" & number & "مورد درخواست شما با موفقيت به پايان رسيد")MsgBox

End Sub

اما
run-time error '13': type mismatch
میده. مشکل کجاست ؟؟


Dim lastcount As Integer رو به Dim lastcount As string هم تغییر دادم اما بازم نشد.

[iranweld]

نمونه فایلی که مشکل داره رو بصورت زیپ شده ضمیمه سایت کنید