That pretty much says all that needs to be said.
Try this file:
http://www.jlathamsite.com/uploads/MoveInGroups.xls
One thing in code that you will definitely have to change,
Const sourceSheet = "Sheet1"
got to change that to the name of the sheet in your workbook with the data
on it when you move the code into it.
You can change any of the Const values you need to for your particular
circumstances. Right now it's set up to copy from E:R (and both are
definable) plus any extras beyond R that you end up using, and the paste goes
in starting at U5 on the R# sheets, and the offsets to deal with any copying
done beyond column R of the source sheet is now done with some math, so
that's handled automatically.
You can test in this workbook, just remember, when it's done, you're going
to be looking at cell A2 on the R# sheets, and there's nothing on the two
sheets created other than the copied data - which is way over at column U.
Enjoy.
"Shu of AZ" wrote:
I'm not sure how to thank you except to tell you thanks!!!!
"JLatham" wrote:
I hope this code does what you want. Tried to build it flexible enough to
meet your needs regardless of answers to my questions earlier.
There are two Const values at the beginning - you need to change those based
on reality at your end.
The code will create an R# sheet if required at any phase of the process, if
such a sheet already exists, it uses it, but always starts pasting at C5 even
if previous information is on that sheet.
Farther down into the code you'll find reference to variable DPCO, the lines
both look like
DPCO = DPCO+1
one is active, the other is inactive (has ' at start of it) Depending on
which of those you leave active, you'll either preserve blank cells past
column R or not. Only one of the entries should be active at any given time.
Sub MoveInGroups()
'change these two Const values as required
'next is sheet name with sourceData on it
Const sourceSheet = "Sheet1"
'next is first column to copy, change to A or E as needed
Const firstColumn = "E"
Dim lastRow As Long
Dim lastColumn As Long ' prep for O2K7
Dim destSheet As String
Dim DPRO As Long ' Destination Page Row Offset
Dim SPCO As Long ' Source Page Column Offset
Dim DPCO As Long ' Destination Page Column Offset
Dim currentGroup As Integer
Dim LC As Long
Dim RC As Long
Dim dummyTest As Variant
On Error Resume Next
lastRow = Worksheets(sourceSheet).Range("C" & _
Rows.CountLong).End(xlUp).Row
If Err < 0 Then
lastRow = Worksheets(sourceSheet).Range("C" _
& Rows.Count).End(xlUp).Row
Err.Clear
End If
On Error GoTo 0
For LC = 1 To lastRow - 1
Worksheets(sourceSheet).Range("C1").Select
If Not IsEmpty(ActiveCell.Offset(LC, 0)) Then
destSheet = "R" & ActiveCell.Offset(LC, 0)
If ActiveCell.Offset(LC, 0) < currentGroup Then
currentGroup = ActiveCell.Offset(LC, 0)
DPRO = 0 ' reset
End If
End If
Range(firstColumn & ActiveCell.Offset(LC, 0).Row & ":R" _
& ActiveCell.Offset(LC, 0).Row).Copy
'either go to the 'R#' sheet or create one if it doesn't exist
On Error Resume Next
dummyTest = Worksheets(destSheet).Range("A1").Value
Application.ScreenUpdating = False
If Err < 0 Then
'need to create the sheet
Sheets.Add
ActiveSheet.Name = destSheet
ActiveSheet.Range("A2").Select
Worksheets(sourceSheet).Select
Err.Clear
Else
Worksheets(destSheet).Activate
Range("A2").Select
End If
On Error GoTo 0
Worksheets(sourceSheet).Select
Range("C1").Select
Application.ScreenUpdating = True
Worksheets(destSheet).Range("C5").Offset(DPRO, 0).PasteSpecial _
xlPasteValues
'now have to find if there are more cells to copy from
'source row to dest row
'test if we need to do any of this at all
'if nothing beyond Column R (column #18), nothing to do
lastColumn = _
Worksheets(sourceSheet).Range("IV" & ActiveCell.Offset(LC, 0).Row). _
End(xlToLeft).Column
If lastColumn Range("R1").Column Then
'yes, something out there somewhere
SPCO = 1
If firstColumn = "E" Then
DPCO = 14
Else
DPCO = 16
End If
For RC = 18 To lastColumn
If Not IsEmpty(Worksheets(sourceSheet).Range("R" & _
ActiveCell.Offset(LC, RC).Row).Offset(0, SPCO)) Then
Worksheets(destSheet).Range("C5").Offset(DPRO, DPCO) = _
Worksheets(sourceSheet).Range("R" & ActiveCell. _
Offset(LC, RC).Row).Offset(0, SPCO)
' if active here, does not move empty cells
'DPCO = DPCO + 1
End If
SPCO = SPCO + 1
' if active here, not above, preserves empty cells
DPCO = DPCO + 1
Next
End If
'
DPRO = DPRO + 1
Next ' LC loop
Application.CutCopyMode = False
Range("A1").Select
'need to go to sheet R1 specifically? Activate this line
'just make sure it will always exist
'Worksheets("R1").Select
End Sub
"Shu of AZ" wrote:
Using the data sheet below, how do I write a macro that would find the data
that extists between the first (#1) (C2), (there's a header), to the last
(#1) (C10), INCLUDING any blank rows there may be between them and copy then
paste ALL the data from column A to S, to another sheet named R1. NOTE: this
needs to exclude any blank colums past (R) and further(I excluded the data
just for ease).
After that it needs to come back to this data sheet and copy everything
between the (#2)'s and copy them to R2 and so on until it reaches no other
numbers usually around the number 10, then return to R1, cell (A2).
Note, I put hyphens between cell values in row 2 to indicate new adjacent
cell value.
The copy begins in column E and goes to column R
The top left cell on the sheet R1 is C5 where the paste begins
Thanks everyone.
x a b c d e f g h i j
1 Header
2 110-fm-1-Hol-81-11/01/2006-Easy Obsession-T-8.50-0.50
3 111 fst 1 Fpx 79 09/24/2006 Easy Obsession D 8.50 3.00
4 113 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
5 114 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
6 115 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
7 116 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
8 Blank row
9 117 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
10 118 fst 1 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
11 119 fst 2 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
12 120 fst 2 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00
13 121 fst 2 Fpx 72 09/10/2006 Easy Obsession D 6.00 0.00