-
Dec 2nd, 2020, 11:04 AM
#1
Thread Starter
Member
[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
-
Dec 2nd, 2020, 02:40 PM
#2
Thread Starter
Member
Re: Copy the Data one by one till the cell is empty
Hi Everyone.
Can any one Help me on this
-
Dec 3rd, 2020, 03:18 AM
#3
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
-
Dec 3rd, 2020, 06:49 AM
#4
Thread Starter
Member
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.
-
Dec 4th, 2020, 04:42 AM
#5
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
-
Dec 4th, 2020, 02:55 PM
#6
Thread Starter
Member
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
-
Dec 4th, 2020, 09:58 PM
#7
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
-
Dec 5th, 2020, 08:45 AM
#8
Thread Starter
Member
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
-
Dec 6th, 2020, 02:08 AM
#9
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
-
Dec 7th, 2020, 09:06 AM
#10
Thread Starter
Member
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.
-
Dec 7th, 2020, 11:53 AM
#11
Thread Starter
Member
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.
-
Dec 7th, 2020, 03:10 PM
#12
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
-
Dec 11th, 2020, 04:04 AM
#13
Thread Starter
Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|