Streamlining my code

N

Novice Lee

Can someone help me with streamling the following code? I have other thing I
want to do with it (but that is for another time) I just don't want it to get
out of control

Sub Moving_Data()

'
'open Master Extraction File
'
Workbooks.Open Filename:= _
"C:\Documents and Settings\johnsonl\My Documents\Master First
Floor.xls"
Columns("a:Z").Select
Selection.Cut
Range("b1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

'
'Add ALD Sheet
'
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "ALD"
Range("A1").Select
Sheets("ALD").Select
Sheets("ALD").Move After:=Sheets("Summary")
Sheets("Summary").Select
'
'Add Visual Sheet
'
Sheets.Add
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Visual"
Range("A1").Select
Sheets("Visual").Select
Sheets("Visual").Move After:=Sheets("ALD")
Sheets("Summary").Select
Range("A1").Select
'
'copyheader to each sheet
'
Rows("1:1").Select
Selection.Copy
Sheets("ALD").Select
Rows("1:1").Select
ActiveSheet.Paste
Sheets("Visual").Select
Rows("1:1").Select
ActiveSheet.Paste
Sheets("Summary").Select
'
' Set RowCount
'
Sh1RowCount = 2
sh2RowCount = 2
Sh3RowCount = 2
'
' Move Data
'
With Sheets("Summary")
Do While .Range("b" & Sh1RowCount) <> ""
If .Range("d" & Sh1RowCount) <> "" Then
.Rows(Sh1RowCount).Copy _
Destination:=Sheets("ald").Rows(sh2RowCount)
sh2RowCount = sh2RowCount + 1
End If
If .Range("k" & Sh1RowCount) <> "" Then
.Rows(Sh1RowCount).Copy _
Destination:=Sheets("visual").Rows(Sh3RowCount)
Sh3RowCount = Sh3RowCount + 1
End If
Sh1RowCount = Sh1RowCount + 1
Loop
End With
'
' Autofit the columns
'
Sheets("ALD").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Visual").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Summary").Select
Range("A1").Select

End Sub
 
R

RyanH

I assume you are just wanting your code cleaned up. This should work.

Option Explicit


Sub MoveStuff()

Dim Sh1RowCount As Long
Dim Sh2RowCount As Long
Dim Sh3RowCount As Long

' open Master Extraction File
Workbooks.Open Filename:="C:\Documents and Settings\johnsonl\My
Documents\Master First Floor.xls"

Columns("A:Z").Cut (ActiveSheet.Range("B1"))
Cells.EntireColumn.AutoFit

' add new sheet
Sheets.Add

' rename and move Sheet1
With Sheets("Sheet1")
.Name = "ALD"
.Move After:=Sheets("Summary")
End With

' add new sheet
Sheets.Add

' rename and move Sheet2
With Sheets("Sheet2")
.Name = "Visual"
.Move After:=Sheets("ALD")
End With

' copyheader from Summary to Visual and ALD
Sheets("Summary").Rows("1:1").Copy
Sheets("Visual").Paste Destination:=Sheets("Visual").Range("A1")
Sheets("ALD").Paste Destination:=Sheets("ALD").Range("A1")

' Move Data
Sh1RowCount = 2
Sh2RowCount = 2
Sh3RowCount = 2

With Sheets("Summary")
Do While .Range("B" & Sh1RowCount) <> ""
If .Range("D" & Sh1RowCount) <> "" Then
.Rows(Sh1RowCount).Copy (Sheets("ALD").Rows(Sh2RowCount))
Sh2RowCount = Sh2RowCount + 1
End If
If .Range("K" & Sh1RowCount) <> "" Then
.Rows(Sh1RowCount).Copy (Sheets("Visual").Rows(Sh3RowCount))
Sh3RowCount = Sh3RowCount + 1
End If
Sh1RowCount = Sh1RowCount + 1
Loop
End With

' Autofit the columns
Sheets("ALD").Cells.EntireColumn.AutoFit
Sheets("Visual").Cells.EntireColumn.AutoFit
Sheets("Summary").Select

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top