Need assistance to copy data to next empty row in another sheet

adibakale

Board Regular
Joined
Apr 10, 2015
Messages
52
I am new to VBA and would greatly appreciate some assistance with this.

I have a spreadsheet that will take all the data in Sheet1, Column A and will copy the data into Sheet2.
The macro I currently have will transpose all the data from Sheet1:Column A to Sheet2 into 9 columns, then it will move down to the next row and will seperate the data into 9 columns until it reaches the end of the data in Sheet1:ColumnA.

This is a process that needs to be done every day, with new data being imported into Sheet1:ColumnA. Currently, I have to copy the data from Sheet2 into a master spreadsheet everyday because everytime I run the macro, It will overwrite the data in Sheet2 unless I import the data in Sheet1:ColumnA below the previous imported data each time.

I would like to be able to clear out the previous data each day in Sheet1:ColumnA, run the macro and append the results to Sheet2 in the next available empty row, instead of overwriting the data. I apologize if this is not clear and will provide clarification if necessary. Again, any help will be greatly appreciated.

Below is the Macro I am using. Please help me make the necessary changes to accomplish this.



Sub copyChunk()
' copy chunks of 9 cells from column A of sheet 1
' and paste their transpose on sheet 2
' starting in the first row
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range
Dim chunk As Integer
chunk = 9
Set sh1 = ActiveWorkbook.Sheets("Import")
Set sh2 = ActiveWorkbook.Sheets("Results")
' picking the starting point here - this could be "anywhere"
Set r1 = Range(sh1.Cells(1, 1), sh1.Cells(chunk, 1))
Set r2 = sh2.[B2]
While Application.WorksheetFunction.CountA(r1) > 0
r1.Copy
r2.PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True, Transpose:=True
' move down "chunk" cells for the source
Set r1 = r1.Offset(chunk, 0)
' move down one row for the destination
Set r2 = r2.Offset(1, 0)
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
Wend
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
This is the actual Macro I am using (without comments). I also removed the bottom part of the macro:

(lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select)


Sub copyChunk()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range
Dim chunk As Integer
chunk = 9

Set sh1 = ActiveWorkbook.Sheets("Import")
Set sh2 = ActiveWorkbook.Sheets("Results")

Set r1 = Range(sh1.Cells(1, 1), sh1.Cells(chunk, 1))
Set r2 = sh2.[B2]

While Application.WorksheetFunction.CountA(r1) > 0
r1.Copy
r2.PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True, Transpose:=True

Set r1 = r1.Offset(chunk, 0)

Set r2 = r2.Offset(1, 0)


Wend

End Sub
 
Upvote 0
See if this is what you want.
Code:
Sub copyChunk()
 ' copy chunks of 9 cells from column A of sheet 1
 ' and paste their transpose on sheet 2
 ' starting in the first row
 Dim sh1 As Worksheet, sh2 As Worksheet
 Dim r1 As Range, r2 As Range
 Dim chunk As Integer
 chunk = 9
 Set sh1 = ActiveWorkbook.Sheets("Import")
 Set sh2 = ActiveWorkbook.Sheets("Results")
 ' picking the starting point here - this could be "anywhere"
 Set r1 = Range(sh1.Cells(1, 1), sh1.Cells(chunk, 1))
 Set r2 = sh2.Cells(Rows.Count, 2).End(xlUp)(2)
 While Application.WorksheetFunction.CountA(r1) > 0
 r1.Copy
 r2.PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True, Transpose:=True
 ' move down "chunk" cells for the source
 Set r1 = r1.Offset(chunk, 0)
 ' move down one row for the destination
 Set r2 = r2.Offset(1, 0)
 lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
 Range("B" & lMaxRows + 1).Select
 Wend
 End Sub
 
Upvote 0
JLGWhiz,

Thank you for the reply, I really appreciate it. It seems to be working, but there are still a couple of issues. I should also mention that Sheet2 is formatted as a table.

1. When I run the Macro, The results begin on Line 210 on Sheet 2. I would like the results to start at B2 on Sheet 2. There is a Header on Line 1

2. Is it possible to run the Macro from any sheet and specify that I want the Macro to run on Sheet1 producing the results on Sheet2? It seems to only work if I run it on the Active Sheet (Sheet1) and doesn't work if I run it when I am viewing Sheet2

Thank you for your help with this. (FYI, I posted a reply to my original post with the original Macro I was using.)
 
Upvote 0
I deleted the Table from Sheet2 and tried it that way and it seems to work.

Is it possible to modify this so it will work with the table?

Sorry for not being clear from the start. Thank you
 
Upvote 0
Change this line of code:
Code:
Set r2 = sh2.Cells(Rows.Count, 2).End(xlUp)(2)
To This:
Code:
Set r2 = sh2.Range("B209").End(xlUp)(2)
This will allow you to retain the table at row 210.
Also, the code should be installed in the standard code module 1(or any numbered module), not a sheet, workbook or UserForm code module. If it is in the standard code module, it is public and can be run with a call from any other code module. By using the object variables sh1 and sh2, it will not be confused with any other sheets in the workbook, however, if you call the sub from another workbook, you would have to tie the sheets to the parent workbook or Excel and VBA will try to tie them to whichever workbook is Active at run time.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top