ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Repeating Reformatting Macro (https://www.excelbanter.com/excel-programming/337395-repeating-reformatting-macro.html)

New2VBA

Repeating Reformatting Macro
 
Project just got tossed to me with little or no IT backup. Need to
write a macro that will take data from columns "A" and "B" (3000+ rows
worth), 52 rows at a time and paste it into rows "D" and "E" leaving
"C" empty. This needs to be repeated so that the next 52 rows of data
skip "F: and get pasted into "G" and "H". The values in A1:B1 also
need to be placed in cells at the top of these pasted columns. Lastly,
I need it to know when to stop automatically. If someone could point
me towards examples that do any or all parts of this, I would greatly
appreciate it.

THANKS!


New2VBA

Repeating Reformatting Macro
 
I wish I could say it looks good, but I don't understand much. I do
know however that it is not working. I get an error message: "Compile
Error - Expected End Sub"

Let me know what I am missing.

Thanks


Jim Thomlinson[_4_]

Repeating Reformatting Macro
 
Give this a try. Make sure the constants are at the very top of the code
module. It is the exact same code just re-arranged a bit. It compiles at this
end so it should be ok...

Private Const IntRows As Integer = 52 'Must be at top of code window
Private Const intColumns As Integer = 3 'Must be at top of code window

Sub MoveRows()
Dim wksFrom As Worksheet
Dim wksTo As Worksheet
Dim rngFrom As Range
Dim rngToData As Range
Dim rngToTitles As Range
Dim rngTitles As Range
Dim rngLastItem As Range

Set wksFrom = Sheets("Sheet2") 'Change The Sheet Name
Set wksTo = Worksheets.Add
Set rngTitles = wksFrom.Range("A1:B1")
Set rngToTitles = wksTo.Range("A1")
Set rngLastItem = wksFrom.Range("A65536").End(xlUp)
Set rngFrom = wksFrom.Range(wksFrom.Cells(2, 1), _
wksFrom.Cells(IntRows + 1, 2))
Set rngToData = wksTo.Range("A2")

Do While Intersect(rngFrom, rngLastItem) Is Nothing
rngFrom.Copy rngToData
rngTitles.Copy rngToTitles
Set rngFrom = rngFrom.Offset(IntRows, 0)
Set rngToData = rngToData.Offset(IntRows, intColumns)
Set rngToTitles = rngToTitles.Offset(0, intColumns)
Loop
End Sub


--
HTH...

Jim Thomlinson


"New2VBA" wrote:

I wish I could say it looks good, but I don't understand much. I do
know however that it is not working. I get an error message: "Compile
Error - Expected End Sub"

Let me know what I am missing.

Thanks



New2VBA

Repeating Reformatting Macro
 
Still not working. Same error message.


Jim Thomlinson[_4_]

Repeating Reformatting Macro
 
It compiles at my end. give this a try. Open a brand new workbook and paste
the code into one of the sheets or into a module and select Debug - Compile
VBA Project
--
HTH...

Jim Thomlinson


"New2VBA" wrote:

Still not working. Same error message.



Jim Thomlinson[_4_]

Repeating Reformatting Macro
 
I trust things are working now?
--
HTH...

Jim Thomlinson


"New2VBA" wrote:

Still not working. Same error message.



New2VBA

Repeating Reformatting Macro
 
Hi Jim,

Thanks for all your help, but I am still getting an error message. The
following line of code seems to halt the execution.

Set rngLastItem = wksFrom.Range("A3274").End(xl*Up)

Any help you can offer would be great.

Thanks!


New2VBA

Repeating Reformatting Macro
 
Ok, I got that line fixed. All my fault (copied with an error). Works
great with one small issue. I need all the columns to start at the 2nd
row. This has done a great job of shifting them to the right, but
doesn't bring them to the top.

Thanks,
Angela



All times are GMT +1. The time now is 12:12 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com