[حل شده] کپی کردن اطلاعات یک شیت به شیت دیگر

[ناصر خان خان]

با سلام خدمت اساتید
همانطور که از موضوع پیداست میخوام اطلاعات یک شیت کپی بشه به شیت مد نظر(بازدن یک دکمه).
لطفا پاسخ بدین ارجاع ندید موضوعات مشابه یا کامل نیستند یا پاک شده. هیچ جا هم پیدا نکردم. خودم یه کد دارم ولی تو خط اولش ارور میده سردر نمیارم_.

Sub copy_columnes()

Dim lastrow As Long, erow As Long
lastrow = Sheet1.Cells(Rows.Count, 2).End(x1up).Row
For i = 8 To lastrow
' If Sheet1.Cells(1, 3) = Sheet1.TextBox1.Text Then
erow = Sheet2.Cells(Rows.Count, 1).End(x1up).Offset(1, 0).Row
Sheet1.Cells(i, 2).Copy
Sheet1.Paste Destination:=Worksheets("sheet2").Cells(erow, 1)
'Sheet1.Cells(i, 3).Copy
' Sheet1.Paste Destination:=Worksheets("sheet2").Cells(erow, 2)
' Sheet1.Cells(i, 7).Copy
' Sheet1.Paste Destination:=Worksheets("sheet2").Cells(erow, 3)

' End If
Next i
'Application.CutCopyMode = False
'Sheet2.Columns().AutoFit
'Range("a1").Select

End Sub

[iranweld]

با سلام


کد خط اول را تغییر بدید به کد ذیل:

lastrow = Sheet1.Cells(Sheet1.Rows.Count, "b").End(xlUp).Row 

یا

lastrow = Sheet1.Cells(Sheet1.Rows.Count, 2).End(xlUp).Row 

[/PHP]

در انتهای کد شما بجای حرف L عدد 1 وارد شده است

End(xlUp).Row 

[ناصر خان خان]

متشکرم بابت جوابتون لطفا روی این فایل انجام بدبد.
قراره از شیت دیتا به شیت دیتا بیس کپی کنه تا هر جا که اطلاعات هست. اگر دوبتره دکمه کپی رو زدیم از ادامه کپی را انجام بده.
به شکلی اطلاعات وارده رو میخوام جای دیگه بکاپ بگیرم.
Book1.xlsx

[M_ExceL]

لطفا روی این فایل انجام بدبد.
قراره از شیت دیتا به شیت دیتا بیس کپی کنه تا هر جا که اطلاعات هست. اگر دوبتره دکمه کپی رو زدیم از ادامه کپی را انجام بده.
به شکلی اطلاعات وارده رو میخوام جای دیگه بکاپ بگیرم.
[ATTACH]18862[/ATTACH]

سلام،
کد زیر تمام رکورد ها رو تا جایی که شماره سند وارد شده است، به شیت database منتقل می کند.
خدمت شما :

Sub enteqal()
Application.ScreenUpdating = False
For h = 1 To 22
Sheets("database").Cells(1, h) = Sheets("data").Cells(7, h + 1)
Next h
lrow1 = Sheets("data").Range("b" & Rows.Count).End(xlUp).Row
lrow2 = Sheets("database").Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To lrow1
If Sheets("data").Range("w" & i + 7) <> "" Then
If Sheets("data").Range("w" & i + 7) <> Sheets("database").Range("v" & i + 1) Then
For ss = 1 To 22
Sheets("database").Cells(i + 1, ss) = Sheets("data").Cells(i + 7, ss + 1)
Next ss
End If
Else
Exit Sub
End If
Next i
Application.ScreenUpdating = True
End Sub

یا حق.

[ناصر خان خان]

آقا دمت گرم