Results 1 to 13 of 13

Thread: [RESOLVED] Copy the Data one by one till the cell is empty

  1. #1

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Resolved [RESOLVED] Copy the Data one by one till the cell is empty

    Hello Everyone,

    I have an Workbook with some data. in that i need to copy some data by manually to another sheet to run another VBA. now i'm looking for if i get the data from sheet 2 by automatically, i can reduce more time on manual process.

    I have a list of data on sheet 2, from that sheet i need to copy the data (by row) into sheet 1 based on Head.(Scenario 1)

    I have to copy the data from sheet 1 to sheet 2, then run my VBA, again goto next line-->this will loop till the cell is empty.

    I have 2 scenarios that i mentioned in attached workbook.if any one is possible that would be perfect for me.
    I'm trying to edit the VBA but not working (for Scenario 2).

    Code:
    Sub Update2()
    Dim p As String, targrange As Range, wbb As Workbook, fnd As Range, sht2 As Worksheet
    Set wbb = ThisWorkbook
    Set targrange = wbb.Sheets("Sheet1").Cells(Rows.COUNT, 1).End(xlUp).Offset(1)
    targrange.Offset(, 5).Resize(, 13).Value = Application.Transpose(ThisWorkbook.Sheets(2).Range("b4:j4").Value)
    
    End Sub
    Someone help me on this.

    Thanks in Advance.

    Sample_2020.zip

  2. #2

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Hi Everyone.

    Can any one Help me on this

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Copy the Data one by one till the cell is empty

    maybe i misunderstand the code, but it appears that you are trying to copy values from 13 cols from col F to b4:j4 which is only 5 cols, also you are transposing the data, when both ranges are on a single row with multi columns, so it would appear there will be some issues
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  4. #4

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Hi westconn,

    Thanks for your reply,
    The code that i attached is maybe wrong... because i tried for various scenarios... please never mind that code.

    I have find the code on below link.

    https://docs.microsoft.com/en-us/off...ta-using-macro

    this code is works somewhat i want, but cant able to copy the range (Row B4:J4)

    Code:
       Sub Test2()
    .Range("A2").Select
       Do Until IsEmpty(ActiveCell)
            Worksheets("sheet1").Range("A2").Value = ActiveCell.Value
    'My code
             ActiveCell.Offset(1, 0).Select
          Loop
       End Sub
    could you Please help me on this code.
    Last edited by thejas; Dec 3rd, 2020 at 08:23 AM.

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Copy the Data one by one till the cell is empty

    you can test this to see if it does as you require
    Code:
    Dim rng As Range, trg As Range, arr
    With ThisWorkbook
        Set rng = .Sheets("sheet1").Cells(.Sheets("sheet1").Rows.Count, 6).End(xlUp).Offset(, -1)
        Set trg = .Sheets("sheet2").Cells(.Sheets("sheet2").Rows.Count, 2).End(xlUp).Offset(1, -1)
    End With
    If IsEmpty(rng) Then   '  Scenario 2
        trg.Resize(, 10).Value = rng.Resize(, 10).Value
        Else        '  Scenario 1
        ReDim arr(9)
        arr(1) = rng:    arr(2) = rng.Offset(, 1): arr(5) = rng.Offset(, 9)
        arr(8) = rng.Offset(, 5): arr(7) = rng.Offset(, 7): arr(9) = rng.Offset(, 8)
        trg.Resize(, 10) = arr
    End If
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  6. #6

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Hi Westconn,

    Thanks for your code. Its working but it's adding the data (Row) in same sheet (Sheet2) instead of transfer the data into sheet 1.
    I have change the sheet no in code as below
    Code:
        Set rng = .Sheets("sheet2").Cells(.Sheets("sheet2").Rows.Count, 6).End(xlUp).Offset(, -1)
        Set trg = .Sheets("sheet1").Cells(.Sheets("sheet1").Rows.Count, 2).End(xlUp).Offset(1, -1)
    then the data transfered (F:J) on sheet2 to (B:F) on sheet1.

    Thanks again

  7. #7
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Copy the Data one by one till the cell is empty

    instead of transfer the data into sheet 1.
    i was probably confused, i thought you wanted the lines from sheet1 copied to sheet2, hence the different scenarios
    anyhow if it works, all good
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  8. #8

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Hi Westconn,
    I did changes on code, now its working for schenario 2.
    but this always copy and paste the last row data only, i want to paste each row ony by one.

    copy and paste the fist row, then my code (i used msgbox in below code.)
    then copy and paste the second row, then my code (i used msgbox in below code.)
    then copy and paste the third row, then my code (i used msgbox in below code.)
    till last cell.

    but this code is always paste the last row directly and show the msgbox.

    could you please help/suggest me where i did mistake.

    code 1

    Code:
    Sub Test()
    Dim rng As Range, trg As Range, arr
    With ThisWorkbook
        Set rng = .Sheets("sheet2").Cells(.Sheets("sheet2").Rows.Count, 2).End(xlUp).Offset(, -1)
        Set trg = .Sheets("sheet1").Cells(.Sheets("sheet1").Rows.Count, 6).End(xlUp).Offset(1, -1)
    End With
    If IsEmpty(rng) Then   '  Scenario 2
        trg.Resize(, 10).Value = rng.Resize(, 10).Value
        Else        '  Scenario 1
        ReDim arr(9)
        arr(1) = rng:    arr(2) = rng.Offset(, 1): arr(5) = rng.Offset(, 9)
        arr(8) = rng.Offset(, 5): arr(7) = rng.Offset(, 7): arr(9) = rng.Offset(, 8)
        trg.Resize(, 10) = arr
    End If
    MsgBox "This is a sample box"
    End Sub
    Code 2
    Code:
       Sub Test2()
    Range("b2").Select
    Dim rng As Range, trg As Range, arr
    With ThisWorkbook
        Set rng = .Sheets("sheet2").Cells(.Sheets("sheet2").Rows.Count, 2).End(xlUp).Offset(, -1)
        Set trg = .Sheets("sheet1").Cells(.Sheets("sheet1").Rows.Count, 6).End(xlUp).Offset(1, -1)
    End With
       Do Until IsEmpty(ActiveCell)
        trg.Resize(, 10).Value = rng.Resize(, 10).Value
    'My code
    MsgBox "This is a sample box"
             ActiveCell.Offset(1, 0).Select
          Loop
       End Sub
    Thanks

  9. #9
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Copy the Data one by one till the cell is empty

    I have to copy the data from sheet 1 to sheet 2, then run my VBA,
    no wonder i was confused

    this appears to do what you want, though all my sample data is scenario 1, i assumed you wanted to copy from the top down, but simple enough if you want the other way
    Code:
    Sub Test()
    Dim rng As Range, trg As Range, arr
    Dim rw As Long, frw As Long, lrw As Long
    With ThisWorkbook
        Set trg = .Sheets("sheet1").Cells(.Sheets("sheet1").Rows.Count, 6).End(xlUp).Offset(1, -1)
        lrw = .Sheets("sheet2").Cells(.Sheets("sheet2").Rows.Count, 2).End(xlUp).Row    ' last row in column b
    End With
    frw = 4   ' first row with data
    For rw = frw To lrw
        Set rng = ThisWorkbook.Sheets("sheet2").Cells(rw, 1)
        If IsEmpty(rng) Then   '  Scenario 2
            trg.Offset(rw - frw).Resize(, 10).Value = rng.Resize(, 10).Value
            Else        '  Scenario 1
            ReDim arr(9)
            arr(1) = rng:    arr(2) = rng.Offset(, 1): arr(5) = rng.Offset(, 9)
            arr(8) = rng.Offset(, 5): arr(7) = rng.Offset(, 7): arr(9) = rng.Offset(, 8)
            trg.Offset(rw - frw).Resize(, 10) = arr
        End If
        Debug.Print "This is a sample box for row " & rw
    '    MsgBox "This is a sample box for row " & rw
    Next
    End Sub
    i swapped the messagebox out as i got sick of clicking it, but it would work the same
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  10. #10

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Thank you so much Westconn.

    Its working, but i got an issue,

    I run the code using F8 key (Step by Step), and found at first time it's not copy the data to the target, it just skip the below line.
    from second loop only the data transferred, so i got an issue with first line of data.

    This line not reading on first loop/Run
    Code:
             trg.Resize(, 10).Value = rng.Resize(, 10).Value
    Code
    Code:
    Sub Tests()
     Dim rng As Range, trg As Range, arr
    Dim rw As Long, frw As Long, lrw As Long
    With ThisWorkbook
    '    Set trg = .Sheets("AB").Cells(.Sheets("AB").Rows.COUNT, 6).End(xlUp).Offset(1, -1)
         Set trg = .Sheets("AB").Range("E3:N3")
         lrw = .Sheets("CLEANUP").Cells(.Sheets("CLEANUP").Rows.COUNT, 2).End(xlUp).Row    ' last row in column b
    End With
    frw = 3   ' first row with data
    For rw = frw To lrw
        Set rng = ThisWorkbook.Sheets("CLEANUP").Cells(rw, 1)
        If IsEmpty(rng) Then   '  Scenario 2
             trg.Resize(, 10).Value = rng.Resize(, 10).Value
            Else        '  Scenario 1
            ReDim arr(9)
            arr(1) = rng:    arr(2) = rng.Offset(, 1): arr(5) = rng.Offset(, 9)
            arr(8) = rng.Offset(, 5): arr(7) = rng.Offset(, 7): arr(9) = rng.Offset(, 8)
            trg.Offset(rw - frw).Resize(, 10) = arr
        End If
    Call Macro5
    Next
    End Sub
    Thanks
    Last edited by thejas; Dec 7th, 2020 at 01:50 PM.

  11. #11

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Thank you so much Westconn.

    Its working, but i got an issue,

    I run the code using F8 key (Step by Step), and found at first time it's not copy the data to the target, it just skip the below line.
    from second loop only the data transferred, so i got an issue with first line of data.

    This line not reading on first loop/Run
    Code:
             trg.Resize(, 10).Value = rng.Resize(, 10).Value
    Code
    Code:
    Sub Tests()
     Dim rng As Range, trg As Range, arr
    Dim rw As Long, frw As Long, lrw As Long
    With ThisWorkbook
    '    Set trg = .Sheets("AB").Cells(.Sheets("AB").Rows.COUNT, 6).End(xlUp).Offset(1, -1)
         Set trg = .Sheets("AB").Range("E3:N3")
         lrw = .Sheets("CLEANUP").Cells(.Sheets("CLEANUP").Rows.COUNT, 2).End(xlUp).Row    ' last row in column b
    End With
    frw = 3   ' first row with data
    For rw = frw To lrw
        Set rng = ThisWorkbook.Sheets("CLEANUP").Cells(rw, 1)
        If IsEmpty(rng) Then   '  Scenario 2
             trg.Resize(, 10).Value = rng.Resize(, 10).Value
            Else        '  Scenario 1
            ReDim arr(9)
            arr(1) = rng:    arr(2) = rng.Offset(, 1): arr(5) = rng.Offset(, 9)
            arr(8) = rng.Offset(, 5): arr(7) = rng.Offset(, 7): arr(9) = rng.Offset(, 8)
            trg.Offset(rw - frw).Resize(, 10) = arr
        End If
    Call Macro5
    Next
    End Sub
    Thanks
    Last edited by thejas; Dec 7th, 2020 at 01:51 PM.

  12. #12
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Copy the Data one by one till the cell is empty

    i am not sure if it is correct but in my sample the first 3 lines are all headers, so your loop will not copy line 3, as designed
    if you also want to copy the header, you should do that separate from the data
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  13. #13

    Thread Starter
    Member
    Join Date
    Sep 2017
    Posts
    54

    Re: Copy the Data one by one till the cell is empty

    Okay.. Thank you so much westconn..
    I'll try with your code.


    Thank you so much for your code.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width