انتقال داده (از آخرین سطر شیت (پرشده) به شیت دیگر)

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • nimak2

    • 2021/07/24
    • 5

    [حل شده] انتقال داده (از آخرین سطر شیت (پرشده) به شیت دیگر)

    سلام به اساتید محترم
    کد وی بی ای می خوام که :
    آخرین سطر پر شده یک شیت را به چند سلول در ستون های مختلف شیت دیگر انتقال دهد.
    توضیح : جداولی دارم در شیت های مختلف . می خواهم با هر بار ثبت اطلاعات در یوزر فرم .اطلاعات (مثال: ( از سلول a10 (آخرین سلول پر شده شیت 1) ) به (سلول a10 - h10- as10 و .....(در شیت 2))) کپی شود.
    اساتید و دوستان محترم ممنون میشم اگر راهنمایی بفرمایید.
  • nimak2

    • 2021/07/24
    • 5

    #2

    این نمونه کد هست.فقط متاسفانه تمام ستون شیت کپی میکنه. من می خواهم فقط آخرین سلول پر ستون کپی بشه

    کد:
    Sub COPY()
    
    
    Dim lastrow As Long, erow As Long
    
    
    lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
    
    
    erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    
    Sheet1.Cells(i, 1).COPY
    Sheet1.Paste Destination:=Worksheets("sheet2").Cells(erow, 1)
    
    
    Next i
    Application.CutCopyMode = False
    Sheet2.Columns().AutoFit
    
    
    End Sub

    کامنت

    • iranweld

      • 2015/03/29
      • 3341

      #3
      با سلام

      کد پیوست را بررسی کنید

      کد PHP:
      Sub COPY()

      Dim lastrow As Longerow As Long



      lastrow 
      Sheets("Sheet1").Cells(Rows.Count1).End(xlUp).Row



      erow 
      Sheets("Sheet2").Cells(Rows.Count1).End(xlUp).Row 1



      Sheets
      ("Sheet1").Cells(lastrow1).COPY Destination:=Sheets("Sheet2").Cells(erow1)


      Application.CutCopyMode False
      Sheets
      ("Sheet1").Columns().AutoFit



      End Sub 

      کامنت

      • nimak2

        • 2021/07/24
        • 5

        #4
        نوشته اصلی توسط iranweld
        با سلام

        کد پیوست را بررسی کنید

        کد PHP:
        Sub COPY()

        Dim lastrow As Longerow As Long



        lastrow 
        Sheets("Sheet1").Cells(Rows.Count1).End(xlUp).Row



        erow 
        Sheets("Sheet2").Cells(Rows.Count1).End(xlUp).Row 1



        Sheets
        ("Sheet1").Cells(lastrow1).COPY Destination:=Sheets("Sheet2").Cells(erow1)


        Application.CutCopyMode False
        Sheets
        ("Sheet1").Columns().AutoFit



        End Sub 
        واقعا ممنون بابت جواب.کد ها کاملا کار میکنن.
        فقی من یک مشکلی دارم.همین کدهارو توی یک اکسل زدم و کاملا کار کرد.حتی یک سری تغیرات کوچک دادم و باز کار کرد. و لی همین کد رو توی برنامه خودم به کار میبرم درست کار نمیکنه.امکانش هست به صورت خصوصی فایل رو براتون ارسال کنم.چون نمی تونم توی انجمن ارسال کنم.و باز هم تشکر محبت کردین

        کامنت

        چند لحظه..