Copy data in one worksheet to another VBA

JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 8, 2018 at 03:03 PM - Latest reply: ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen
- Apr 16, 2018 at 05:00 PM
Hi all,

I am trying very hard with little success to automate this with VBA.

I am trying to copy data from Sheet1 Row1 in Column A, B & C and then paste it into Sheet2 Row1 Column A, B & C (paste 5 times) then move back to Sheet1 and copy data in Row 2 Column A, B & C and paste it in to Sheet2, next available row. I am trying to do this until I reach a blank row in Sheet1. Have tried offset, etc but going around in circles.
Any help , advice or guidance would be very much appreciated.
See more 

Your reply

14 replies

Best answer
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Updated by ac3mark on 12/04/18 at 05:10 PM
1
Thank you
OK, here is the code as written, and tested, and runs. Please understand, this code is for you to modify to your model. If you receive an error, I will assist, but I will need a screen shot of the error.

I hope this helps:
Option Explicit

Public sheet1, sheet2 'this makes these SHEETS available to all code in this worksheet
Public rowcountStorageLocation

'#######################################

Private Sub Workbook_Open()
Call Initialize
End Sub

'#######################################

Sub Initialize()
sheet1 = "Sheet1"
sheet2 = "Sheet2"
rowcountStorageLocation = "A1"

'#######################################

ThisWorkbook.Worksheets(sheet1).Select
If Worksheets(sheet1).Range(rowcountStorageLocation).Value = "" Then
Worksheets(sheet1).Range(rowcountStorageLocation).Value = 0
End If
Call updatecounts
End Sub

'#######################################

Sub updatecounts(Optional recount As Boolean)
Dim rowssheet1, rowssheet2

If recount = True Then
ThisWorkbook.Worksheets(sheet2).Select
rowssheet2 = Cells(ThisWorkbook.Worksheets(sheet2).Rows.Count, 1).End(xlUp).Row
Worksheets(sheet2).Range(rowcountStorageLocation).Value = rowssheet2 - 1
Exit Sub
End If

ThisWorkbook.Worksheets(sheet2).Select
rowssheet2 = Cells(ThisWorkbook.Worksheets(sheet2).Rows.Count, 1).End(xlUp).Row
Worksheets(sheet2).Range(rowcountStorageLocation).Value = rowssheet2 - 1

ThisWorkbook.Worksheets(sheet1).Select
rowssheet1 = Cells(ThisWorkbook.Worksheets(sheet1).Rows.Count, 1).End(xlUp).Row
Worksheets(sheet1).Range(rowcountStorageLocation).Value = rowssheet1 - 1
End Sub

'########################################

Sub transferData()
'######################DEPLOYMENT CONSIDERATIONS#################################################
'#after pasting this code, you need to go into the Developer tab, and press the MACROS button. #
'#Select this Subroutine in the MACRO WINDOW, and place a SHORTCUT key to whatever you see fit. #
'# SEE EXAMPLE PICTURES POSTED ON FORUM #
'################################################################################################

Dim sheet1rows, sheet2rows
Dim rowsCnt1, rowsCnt2
Dim StartRow, endingrow
Dim pasteTime

sheet1 = "Sheet1"
sheet2 = "Sheet2"
rowcountStorageLocation = "A1"

'get the number of lines for each sheet
sheet1rows = Worksheets(sheet1).Range(rowcountStorageLocation).Value

'we need to start the new count from the values above, after we count the lines again
ThisWorkbook.Worksheets(sheet1).Select
rowsCnt1 = Cells(ThisWorkbook.Worksheets(sheet1).Rows.Count, 1).End(xlUp).Row - 1

If rowsCnt1 <> sheet1rows Then
MsgBox ("Will Move Data at This Time.")
ThisWorkbook.Worksheets(sheet2).Select
sheet2rows = Cells(ThisWorkbook.Worksheets(sheet2).Rows.Count, 1).End(xlUp).Row + 1

endingrow = rowsCnt1 - sheet1rows
For StartRow = sheet1rows + 1 To sheet1rows + endingrow
ThisWorkbook.Worksheets(sheet1).Select
ActiveSheet.Range("A" & StartRow + 1).EntireRow.Copy
ThisWorkbook.Worksheets(sheet2).Select
ActiveSheet.Paste Destination:=ThisWorkbook.Worksheets(sheet2).Range("A" & sheet2rows & ":" & "A" & sheet2rows + 5)
updatecounts (True)
sheet2rows = Worksheets(sheet2).Range(rowcountStorageLocation).Value + 1
ThisWorkbook.Worksheets(sheet1).Select
Next
ThisWorkbook.Worksheets(sheet1).Range("A1").Select
Call updatecounts
Else
MsgBox ("No New Entry was Found.")
End If
End Sub

'########################################

YOu will need to assign a shortcut key to the macro, see examples below.






Thank you, ac3mark 1

Something to say? Add comment

CCM has helped 1587 users this month

Thanks Mark for this. Much appreciated. Can't wait to study it in the morning. I will let you know how I get on.
JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 16, 2018 at 02:36 PM
perfect!
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Apr 16, 2018 at 05:00 PM
You can mark it as solved if you wish! I am glad you were able to learn the steps to accomplish your task!
Respond to ac3mark
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Apr 9, 2018 at 04:52 PM
0
Thank you
OK, what you are asking is very simple, although complex. Post your code here, and we will see where it is giving you issues. Perhaps you need to read this:
https://ccm.net/faq/53497-how-to-manipulate-data-in-excel-using-vba

Are you familiar with FOr loops?
We are volunteers who help when stuck, not provide turn key solutions.
JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 10, 2018 at 03:31 AM
Hi Mark,
Thanks so much for the feedback. Here is one version. That is just set up to copy the data to the same sheet to begin with. The only data entry that I can get to copy 5 times is the final one!
And no I am not so familiar with for loops but I am willing to learn, as this issue i am experiencing is my start in the journey of VBA.

Sub xx()
Dim n As Long
n = [COUNTA(A:A)]
'Goes through each row line by line
For i = 1 To n Step 1
'Copies data in range A1:B1
Range("A1:c1").Offset(i - 1, 0).Select
Selection.Copy


Range("d1:d5").Offset((i - 2) / 1 + 1, 0).Select
Selection.PasteSpecial
JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 10, 2018 at 03:36 AM
Mark,

Here is another poor attempt!

Sub Macro1()
'
' Macro1 Macro
'copy normal data

''Loop until a blank cell is found in Column b



Sheets("Sheet1").Select
Range("B2:D2").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B2:B6").Select
ActiveSheet.Paste
Columns("B:B").EntireColumn.AutoFit
Sheets("Sheet1").Select
Range("B2:D2").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("b" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial



Do While BlankFound = False
x = x + 1
If Cells(x, "b").Value = "" Then
BlankFound = True
End If


Loop
Respond to ac3mark
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Updated by ac3mark on 10/04/18 at 05:25 PM
0
Thank you
Thanks for the work...I appreciate you posting.

Lets try this, please understand this is just an example of the mechanics, I have not tested it. The important part: These are the methods to get what you want out of, and into another Sheet. I will test and post bak something in the morning. Please post back with any changes or headways you may have on this, so I do not duplicate your solution.

Dim rowcountsheet1, rowcountersheet1
Dim rowcountsheet2, rowcountersheet2
Dim newvalueA, newvalueB, newvalueC

ThisWorkbook.Worksheets("sheet1").Select
rowcountsheet1 = Cells(ThisWorkbook.Worksheets("sheet1").Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets("sheet2").Select
rowcountsheet2 = Cells(ThisWorkbook.Worksheets("sheet2").Rows.Count, 1).End(xlUp).Row


ThisWorkbook.Worksheets("sheet1").Select
MsgBox (newvalueA)

For rowcounter = 1 To rowcountsheet1


newvalueA = ThisWorkbook.Worksheets("sheet1").Range("A" & rowcounter).Value
newvalueB = ThisWorkbook.Worksheets("sheet1").Range("B" & rowcounter).Value
newvalueC = ThisWorkbook.Worksheets("sheet1").Range("C" & rowcounter).Value



ThisWorkbook.Worksheets("sheet2").Select


ThisWorkbook.Worksheets("sheet2").Range("A" & rowcounter + rowcountsheet2).Value = newvalueA
Next



UNderstand, this probably will not run as it is untested, ut is an example of how to get your variables matched up in a FOR loop!

Also, there is a much prettier way to make this all work, but I am leaving the MAGIC out of the code, so you can see how the variables work! I really hope this helps!

Have FUN!
JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 11, 2018 at 04:06 AM
Hi Mark I have run this through the debugger in order to gain an understanding of each section, I am pretty sure i can see what is happening. Appears to be copying data from Column A and transferring this each time. Unsure as to why no data from Column B and C is transferring. If i manage to figure out more I will let you know. Thanks!
JohnMcLaughlin 11 Posts Sunday April 8, 2018Registration date April 19, 2018 Last seen - Apr 11, 2018 at 04:15 AM
Hi Mark I copied
ThisWorkbook.Worksheets("sheet2").Range("A" & rowcounter + rowcountsheet2).Value = newvalueA

and changed A to B and that seemed to copy in the data in Column B. I have done the same for C. So some progress made!

I notice that when you run it a second time the original data gets copied again underneath the data that was already copied. I need to look at stopping this as I only want new data to be added underneath. I also need to look at copying each row of data in five times.
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Apr 11, 2018 at 03:33 PM
OK, well the wireframe is there. I hope you understnad the methods used in selecting and moving the data. If I have time, I will "fix" the "re-Entering" of the data, but as I said, it is an example to teach you how. Thank you for the feedback, but I knew the resulting code would do this, as the "MAGIC" would just confuse and create noise around the learning.
Thanks very much Mark that would be great if you had time.
I was able to use part of the code for something else today.
ac3mark 10810 Posts Monday June 3, 2013Registration dateModeratorStatus November 12, 2018 Last seen - Apr 11, 2018 at 04:01 PM
If you need a loop for five time, then nest the first loop we built with:

For intTIME= 0 to 4
'already have code to loop through the rest
next


As for only entering in the NEW data, that is real sticky, as now we have to keep track on the index, and reference that index before looking at a new run. Does that make sense? Be prepared to utilize Cell ZZZ1 to store a value. As we count each "row", we have to store that number for later referencing. This is not a scaleable solution, as what happens when your data extends beyond ZZZ? If this is a control sheet or something, you may need to look at storing these values into a Database, as opposed to in a spreadsheet!
Respond to ac3mark