Vba Smaller code2

Z

ziad alsayed

Well-known Member
Joined
Jul 17, 2010
Messages
665
dear all

the below Code is working fine, i just need to reduce it
what it simply does that it removes data from onw workbook to another.
each workbook has 6 sheets and each sheet has data for 12 month

hope you can assist in reducing the code.
i am sure it can be reduded, but i am not good in using array yet :)

below is the code

Code: 
Sub MoveSalesByMonth()
Dim wb As Workbook ' this workbook is "Sales Statistics 2007_2011"
Dim wbn As Workbook
Set wb = ActiveWorkbook
Set wsph = wb.Worksheets("PH")
wsph.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
    Sheets("PHC2011 $").Select
    'copy january
    Cells(50, 4).Copy
    wsph.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
    wsph.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsph.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
    wsph.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
    wsph.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsph.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsph.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsph.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
    wsph.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
    wsph.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsph.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
    wsph.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
   
'Apapa Branch
Set wsApapa = wb.Worksheets("Apapa")
wsApapa.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Apapa2011 $").Select
    'copy january
    Cells(50, 4).Copy
  wsApapa.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
   wsApapa.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsApapa.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
   wsApapa.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
   wsApapa.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsApapa.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsApapa.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsApapa.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
   wsApapa.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
   wsApapa.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsApapa.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
   wsApapa.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
    
 'VI Branch
 Set wsVI = wb.Worksheets("VI")
wsVI.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("VI2011 $").Select
'copy january
    Cells(50, 4).Copy
  wsVI.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
   wsVI.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsVI.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
   wsVI.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
   wsVI.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsVI.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsVI.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsVI.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
    wsVI.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
   wsVI.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsVI.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
   wsVI.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
    
    'Kano Branch
 Set wsKano = wb.Worksheets("Kano")
wsKano.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Kano2011 $").Select
'copy january
    Cells(50, 4).Copy
  wsKano.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
   wsKano.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsKano.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
   wsKano.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
   wsKano.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsKano.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsKano.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsKano.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
    wsKano.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
   wsKano.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsKano.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
   wsKano.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
    
'Abuja Branch
 Set wsAbuja = wb.Worksheets("Abuja")
wsAbuja.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Abuja2011 $").Select
'copy january
    Cells(50, 4).Copy
    wsAbuja.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
    wsAbuja.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsAbuja.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
    wsAbuja.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
    wsAbuja.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsAbuja.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsAbuja.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsAbuja.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
    wsAbuja.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
    wsAbuja.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsAbuja.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
    wsAbuja.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
    
'Abuja Branch
 Set wsIkeja = wb.Worksheets("Ikeja")
wsIkeja.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Ikeja2011 $").Select
'copy january
    Cells(50, 4).Copy
    wsIkeja.Cells(8, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy Feb
    Cells(50, 5).Copy
    wsIkeja.Cells(8, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy March
    Cells(50, 6).Copy
    wsIkeja.Cells(8, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy April
    Cells(50, 7).Copy
    wsIkeja.Cells(8, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy may
    Cells(50, 8).Copy
    wsIkeja.Cells(8, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy June
    Cells(50, 9).Copy
    wsIkeja.Cells(8, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy July
    Cells(50, 10).Copy
    wsIkeja.Cells(8, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy August
    Cells(50, 11).Copy
    wsIkeja.Cells(8, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'copy September
    Cells(50, 12).Copy
    wsIkeja.Cells(8, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy October
    Cells(50, 13).Copy
    wsIkeja.Cells(8, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy November
    Cells(50, 14).Copy
    wsIkeja.Cells(8, 12).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy december
    Cells(50, 15).Copy
    wsIkeja.Cells(8, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.Close
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Here is one way to reduce it. Let me play around with it a bit, and I might have it reduced down even more.

Code: 
Sub MoveSalesByMonth()
Dim wb As Workbook ' this workbook is "Sales Statistics 2007_2011"
Dim wbn As Workbook
Dim i As Long
Set wb = ActiveWorkbook
Set wsph = wb.Worksheets("PH")
Application.ScreenUpdating = False
wsph.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
    Sheets("PHC2011 $").Select
    'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
        wsph.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
   
'Apapa Branch
Set wsApapa = wb.Worksheets("Apapa")
wsApapa.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Apapa2011 $").Select
    'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
      wsApapa.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
    
 'VI Branch
 Set wsVI = wb.Worksheets("VI")
wsVI.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("VI2011 $").Select
    'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
      wsVI.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
    
    'Kano Branch
 Set wsKano = wb.Worksheets("Kano")
wsKano.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Kano2011 $").Select
'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
      wsKano.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
    
'Abuja Branch
 Set wsAbuja = wb.Worksheets("Abuja")
wsAbuja.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Abuja2011 $").Select
'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
      wsAbuja.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
    
'Ikeja Branch
 Set wsIkeja = wb.Worksheets("Ikeja")
wsIkeja.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Sheets("Ikeja2011 $").Select
'copy months
    For i = 2 To 13
        Cells(50, i + 2).Copy
      wsIkeja.Cells(8, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next i
    ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Is there any reason you are closing and reopening the Sales Statistics Amount 2011.xlsm over and over again?

Also, in the following block of code:

Code: 
Set wsph = wb.Worksheets("PH")
wsph.Select
ChDir "D:\"
    Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
    Sheets("PHC2011 $").Select

Do you mean to set wsph = wb.Worksheets("PHC")?
 
Last edited:
Upvote 0
thanks MrKowz, the first code you sent is working perfectly.
there is no reason for the opening and closing, that is only the way i succeeded in doing it :)

as for the question :Do you mean to set wsph = wb.Worksheets("PHC")?
it should be as it was set wsph = wb.Worksheets("PH").
i have two workbook the first named Sales Statistics 2007-2011, it is this workbook that i am moving the data into.this workbook has 6 worksheets named "PH","Apapa","VI","kano","Abuja","Ikeja", each of them has the month from jan till dec
the second workbook named Sales Statistics Amount 2011, it is the one i am taking the data From. this also has six worksheets named,"PHC2011 $","Apapa2011 $","VI2011 $","Kano2011 $","Abuja2011 $","Ikeja2011 $"

thanks again for your assistance
<TABLE style="BORDER-TOP-WIDTH: 0px" class=tborder border=0 cellSpacing=1 cellPadding=6 width="100%" align=center><TBODY><TR title="Post 2623472" vAlign=top><TD class=alt1>Do you mean to set wsph = wb.Worksheets("PHC")? </TD></TR><TR><TD class=thead colSpan=2>Today 07:40 PM</TD></TR></TBODY></TABLE>
 
Upvote 0
Give this a shot:

Code: 
Sub MoveSalesByMonth()
' this workbook is "Sales Statistics 2007_2011"
Dim wbdest      As Workbook, _
    wbsource    As Workbook, _
    i           As Long, _
    wsIndex     As Long, _
    wsList      As Variant
 
' Variable Initialization
Set wbdest = ActiveWorkbook
wsList = Array("PH", "Apapa", "VI", "Kano", "Abuja", "Ikeja")
Application.ScreenUpdating = False
Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Set wbsource = ActiveWorkbook
 
' Loop through worksheets and copy data
For wsIndex = 0 To UBound(wsList)
    If wsList(wsIndex) = "PH" Then
        With wbsource.Sheets("PHC2001 $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
    Else
        With wbsource.Sheets(wsList(wsIndex) & "2001 $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
Next j
 
Application.ScreenUpdating = True
 
End Sub
 
Upvote 0
dear MrKowz

it is not working , it is giving me "next without for"
i think it is the last next J , it is not opened with a for

please advise.
thanks in advance.
 
Upvote 0
Sorry, I had switched variable names at the last moment and forgot to change it at the Next line:

Code: 
Sub MoveSalesByMonth()
' this workbook is "Sales Statistics 2007_2011"
Dim wbdest      As Workbook, _
    wbsource    As Workbook, _
    i           As Long, _
    wsIndex     As Long, _
    wsList      As Variant
 
' Variable Initialization
Set wbdest = ActiveWorkbook
wsList = Array("PH", "Apapa", "VI", "Kano", "Abuja", "Ikeja")
Application.ScreenUpdating = False
Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Set wbsource = ActiveWorkbook
 
' Loop through worksheets and copy data
For wsIndex = 0 To UBound(wsList)
    If wsList(wsIndex) = "PH" Then
        With wbsource.Sheets("PHC2001 $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
    Else
        With wbsource.Sheets(wsList(wsIndex) & "2001 $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
[COLOR=red][B]Next wsIndex[/B][/COLOR]
 
Application.ScreenUpdating = True
 
End Sub
 
Upvote 0
dear MrKowz, i really appreciate your assistance, now it is working perfectly. i just amended some slipup and it is perfectly working, i hope that one day i will reach this level in VBA. now it is time to analyze your code ( believe me , i will give it time to understand it)
below in red is what i amended

Code: 
Sub MoveSalesByMonth3()
' this workbook is "Sales Statistics 2007_2011"
Dim wbdest      As Workbook, _
    wbsource    As Workbook, _
    i           As Long, _
    wsIndex     As Long, _
    wsList      As Variant
 
' Variable Initialization
Set wbdest = ActiveWorkbook
wsList = Array("PH", "Apapa", "VI", "Kano", "Abuja", "Ikeja")
Application.ScreenUpdating = False
Workbooks.Open Filename:="D:\Nigeria Files\Sales Statistics Amount\Sales Statistics Amount 2011.xlsm", UpdateLinks:=0
Set wbsource = ActiveWorkbook
 
' Loop through worksheets and copy data
For wsIndex = 0 To UBound(wsList)
    If wsList(wsIndex) = "PH" Then
        With wbsource.Sheets("PHC[COLOR=red]2011[/COLOR] $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
    Else
        With wbsource.Sheets(wsList(wsIndex) & "[COLOR=red]2011[/COLOR] $")
        For i = 2 To 13
            .Cells(50, i + 2).Copy
            wbdest.Sheets(wsList(wsIndex)).Cells(8, i).PasteSpecial Paste:=xlPasteValues
        Next i
        End With
    [COLOR=red] End If
[/COLOR]Next wsIndex
 [COLOR=red]ActiveWorkbook.Close
[/COLOR]Application.ScreenUpdating = True
 
End Sub

thanks again.

one final favour and if you have time , yesterday i posted a longer code(the title was VBA Smaller Code ) and ask to reduce it.
below is the link
http://www.mrexcel.com/forum/showthread.php?t=531095&highlight=vba+smaller+code

pleae feel free , hope i am not asking too much.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
229
kbk
K
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
390
willow1985
willow1985
T
  • Solved
Left of character
Replies
8
Views
135
Peter_SSs
Peter_SSs
A
  • Question Question
Need advise on code
2
Replies
11
Views
175
AlexanderBB
A
S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
205
MikeVol
MikeVol

Forum statistics

Threads
1,224,590
Messages
6,179,749
Members
452,940
Latest member
rootytrip

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top