Move Data with VBA code

January 20, 2012 at 08:19:12
Specs: Windows 7
Move data from one sheet to other I have the following written but am finding i very slow and sluggish around the auto filter and then moving it to a pre set template to import data from main system

Could I please get some guidance in this matter please?

Sub FURNITURE()
'
' Furniture Macro
' Prep FUrniture Report
'
' Keyboard Shortcut: Ctrl+y
'


RANGE("D:D,G:G,H:H").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit


myarray = VBA.Array("SITE 1", "SITE 13", "SITE 42", "SITE 43", "SITE 44", "SITE 45", "SITE 46", "SITE 47", "SITE 50", "SITE 56", "SITE 67")

For xSheet = 0 To 10
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = myarray(xSheet)
With ActiveWorkbook.Sheets(myarray(xSheet)).Tab
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
End With
Next


Sheets("furniture").Select
ActiveWorkbook.Worksheets("furniture").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("furniture").Sort.SortFields.Add Key:=RANGE( _
"F2:F2500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("furniture").Sort
.SetRange RANGE("A1:F1500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:=Array("0", _
"16", "59", "8", "7", "4", "68", "7", "72", "81", "86", "87", "90"), Operator:=xlFilterValues
RANGE("A2").Select
RANGE(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5
Columns("A:E").Select
ActiveWorkbook.Worksheets("furniture").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("furniture").Sort.SortFields.Add Key:=RANGE( _
"E2:E1500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("furniture").Sort
.SetRange RANGE("A1:E1500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Workbooks.Open Filename:= _
"C:\Users\Meguel DeSousa\Desktop\TEMPLATES\Furniture Report Template.xlsx"

Workbooks("FUR TEST").Sheets("furniture").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("Furniture OS Group").RANGE("A1")
Windows("FUR TEST.xlsX").Activate

Sheets("FURNITURE").Select


ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="1"
Selection.Copy
Sheets("SITE 1").Select
RANGE("A1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit

Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="13"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="42"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="43"
Selection.Copy
Sheets("SITE 43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="44"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 44").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="45"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 45").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="46"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="47"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 47").Select
RANGE("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="50"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 50").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="56"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 56").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="67"
Application.CutCopyMode = False
Selection.Copy
Sheets("SITE 67").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Sheets("furniture").Select
Application.CutCopyMode = False
ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5
Windows("Furniture Report Template.xlsx").Activate

Workbooks("FUR TEST").Sheets("Site 1").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 1").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 13").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 13").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 42").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 42").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 43").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 43").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 44").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 44").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 45").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 45").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 46").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 46").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 47").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 47").RANGE("A1")
Workbooks("FUR TEST").Sheets("SITE 50").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 50").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 56").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 56").RANGE("A1")
Workbooks("FUR TEST").Sheets("Site 67").Columns("A:E").Copy Workbooks("Furniture Report Template.xlsX").Sheets("SITE 67").RANGE("A1")





End Sub


See More: Move Data with VBA code

Report •

#1
January 20, 2012 at 09:46:44
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum. When you post code based on those instructions, it will make it much easier for us to read since the formatting of the code from within the VBA editor will be maintained.

Second, one of the reasons your code might be sluggish is because of all the Select instructions.

You should be aware that rarely do you have to Select an object in VBA to perform an action on it. In fact, selecting objects is not only very inefficient but it makes code very difficult to follow.

For example, this:

 Range("D:D,G:G,H:H").Select
   Selection.Delete Shift:=xlToLeft
 Cells.Select
   Cells.EntireColumn.AutoFit

should be written as:

Range("D:D,G:G,H:H").Delete Shift:=xlToLeft
Cells.EntireColumn.AutoFit

this:

Sheets("furniture").Select
 ActiveSheet.RANGE("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="44"

should be written as:

Sheets("furniture").Range("$A$1:$F$1500").AutoFilter Field:=5, Criteria1:="44"

Do you see how much easier it is to read the single lines since all of the information, i.e the object (Range, Sheet, etc) and the action to be taken, are all together?

In fact, I would guess that every one of your "Select" instructions could be eliminated. That alone should speed up your code.

It will also make the code much easier for us to read, and if you want our help, you should try to make it as easy on us as possible. ;-)

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •
Related Solutions


Ask Question