Cut bottom 300 rows to next sheet & repeat

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

Hi Excel Experts,

Sheet "Dum" A, B, C by 1200 rows.
Sheet "Mud" blank.

Trying to cut the bottom 300 rows of A, B, C from "Dum" to A1, B1, C1 in "Mud".
Next bottom 300 from "Dum" to D1, E1, F1 in "Mud" & repeat for a total of 5 times, hence the For i = 1 to 5 - Next.
I get the first bottom 300 from "Dum" to "Mud" correctly and then its 'game over'. If it does one, why not 5?

Option Explicit

Sub ThreeHund()

Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Long
With ThisWorkbook.Worksheets("Dum")
For iColumn = 1 To 3
lLast = Application.Max(lLast, Cells(Rows.Count, iColumn) _
.End(xlUp).Row)
Next iColumn
j = 0
For i = 1 To 5
If lLast < 300 Then
MsgBox "Less than 300 rows", vbOKOnly
Exit Sub
Else
'MsgBox j
.Range("A" & lLast - 299 & ":C" & lLast).Cut Destination:= _
ThisWorkbook.Worksheets("Mud").Range("A1") _
.End(xlUp).Offset(0, j)
End If
j = j + 3
Next
End With
End Sub

Thanks,
Howard
 
hi Howard,

if i have good understand

Sub ThreeHund()
Dim iColumn As Integer
Dim wks1 As Workbook, wks2 As Workbook
Dim lLast As Long
Dim i As Long, j As Long

Set wks1 = Worksheets("Dum")
Set wks2 = Worksheets("Mud")

lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

For iColumn = 2 To 3
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count,
iColumn).End(xlUp).Row)
Next iColumn

If lLast < 300 Then
MsgBox "Less than 300 rows", vbOKOnly
Exit Sub
End If

For i = 300 To lLast Step 300
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
wks1.Range("A" & i & ":C" & i + 299).Copy wks2.Cells(1, j)
Next
End Sub

isabelle

Le 2013-02-19 18:13, Howard a écrit :
 
if it should be not exceeding the column "O"

Sub ThreeHund()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Integer, y As Integer

Set wks1 = Worksheets("Dum")
Set wks2 = Worksheets("Mud")

lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

For iColumn = 2 To 3
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count,
iColumn).End(xlUp).Row)
Next iColumn

If lLast < 300 Then
MsgBox "Less than 300 rows", vbOKOnly
Exit Sub
End If

For i = 300 To lLast Step 300
y = y + 1
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
wks1.Range("A" & i & ":C" & i + 299).Copy wks2.Cells(1, j)

If y = 5 Then wks2.Range("A:A").Delete Shift:=xlToLeft: Exit Sub
Next

Set wks1 = Nothing
Set wks2 = Nothing
End Sub


isabelle
 
i made a modification for avoiding deleting the first column

Sub ThreeHund()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Integer, y As Integer

Set wks1 = Worksheets("Dum")
Set wks2 = Worksheets("Mud")

lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column

For iColumn = 2 To 3
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count,
iColumn).End(xlUp).Row)
Next iColumn

If lLast < 300 Then
MsgBox "Less than 300 rows", vbOKOnly
Exit Sub
End If

For i = 300 To lLast Step 300
y = y + 1
wks1.Range("A" & i & ":C" & i + 299).Copy wks2.Cells(1, j)
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
If y = 5 Then Exit Sub
Next

Set wks1 = Nothing
Set wks2 = Nothing
End Sub


isabelle
 
i made a modification for avoiding deleting the first column



Sub ThreeHund()

Dim wks1 As Worksheet, wks2 As Worksheet

Dim iColumn As Integer

Dim lLast As Long

Dim i As Long, j As Integer, y As Integer



Set wks1 = Worksheets("Dum")

Set wks2 = Worksheets("Mud")



lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column



For iColumn = 2 To 3

lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count,

iColumn).End(xlUp).Row)

Next iColumn



If lLast < 300 Then

MsgBox "Less than 300 rows", vbOKOnly

Exit Sub

End If



For i = 300 To lLast Step 300

y = y + 1

wks1.Range("A" & i & ":C" & i + 299).Copy wks2.Cells(1, j)

j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1

If y = 5 Then Exit Sub

Next



Set wks1 = Nothing

Set wks2 = Nothing

End Sub





isabelle
Click to expand...

Thanks isabelle for you time and effort. I appreciate it.

I'm using the last code you posted and it is almost there. The problem it is showing me is that the the first 300 rows on sheet Mud starts with the 3ooth row from Dum. So I am winding up with row 300 to 599 in A, B, C.
In D, E, F it is rows 600 to 899.
In G, H, I it is rows 900 to 1199.
In J, K, L it is rows 1200 to 1499.
In M, N, O it is a single row 1500.

So I'm missing the first 299 rows and have a single row from the last ireteration. I am studying the code to see if I can fix it on my end since its pretty close but not getting anywhere.

Howard
 
hi Howard,

if you want to start at the first line or the second line
just make this change
For i = 300 To lLast Step 300
by
For i = 1 To lLast Step 300
or by
For i = 2 To lLast Step 300

and if it could be exceeding the column "O" on sheet "Mud"
just remove this code lines
y = y + 1
If y = 5 Then Exit Sub

if i misunderstand, please tell me

isabelle

Le 2013-02-19 22:38, Howard a écrit :
Thanks isabelle for you time and effort. I appreciate it.

I'm using the last code you posted and it is almost there.
Click to expand...

The problem it is showing me is that the the first 300 rows on sheet Mud
starts with the 3ooth row from Dum.

So I am winding up with row 300 to 599 in A, B, C.
In D, E, F it is rows 600 to 899.
In G, H, I it is rows 900 to 1199.
In J, K, L it is rows 1200 to 1499.
In M, N, O it is a single row 1500.

So I'm missing the first 299 rows and have a single row from the last ireteration.
Click to expand...

I am studying the code to see if I can fix it on my end since its pretty
close but not getting anywhere.
 
hi Howard,



if you want to start at the first line or the second line

just make this change

For i = 300 To lLast Step 300

by

For i = 1 To lLast Step 300

or by

For i = 2 To lLast Step 300



and if it could be exceeding the column "O" on sheet "Mud"

just remove this code lines

y = y + 1

If y = 5 Then Exit Sub



if i misunderstand, please tell me



isabelle



Le 2013-02-19 22:38, Howard a écrit :






The problem it is showing me is that the the first 300 rows on sheet Mud

starts with the 3ooth row from Dum.



So I am winding up with row 300 to 599 in A, B, C.







I am studying the code to see if I can fix it on my end since its pretty

close but not getting anywhere.
Click to expand...

Bingo! You have given me a winner. Thank you very much, isabelle.

Regards,
Howard
 
Back
Top