You are here:

Excel/Excel VBA loop through columns in range and copy


QUESTION: I am new to Excel VBA and need some help to write a macro.

From Worksheet1 of Workbook1 I need to copy each column of range D1:Z100, one at a time, and pasteValue it to cells B1:B100.

This triggers a calculation in Worksheet2 of Workbook1. Here I need to copy cells A1:B200 into a new workbook.

This new workbook is to be renamed with the text string in Worksheet1, cell B1. The new workbook is to be saved into the same folder as Workbook1.

The loop is then to continue with the next column from Worksheet1, and continue until all columns in the range have been treated this way.

I have searched for days on the net and cannot find a solution....

All help gratefully recieved!


ANSWER: Rob March

Sub abc()
Dim bk1 As Workbook, sPath As String
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim col As Range, r As Range
Set bk1 = ThisWorkbook
sPath = bk1.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set sh1 = bk1.Worksheets("Sheet1")  '<== change name to match your worksheet1
Set sh2 = bk1.Worksheets("Sheet2")  '<== change name to match your worksheet2
For Each col In sh1.Range("D1:Z100").Columns
 Set r = col.Cells
 ' paste each column (rows 1 to 100) to B1 of worksheet1
 r.Copy sh1.Range("B1")
 ' add a new single sheet workbook
 Workbooks.Add Template:=xlWBATWorksheet
 Set sh3 = ActiveWorkbook.Worksheets(1)
 sh3.Range("A1:B200").PasteSpecial xlValues
 sh3.Range("A1:B200").PasteSpecial xlFormats
 ActiveWorkbook.SaveAs sPath & sh1.Range("B1").Text
 ActiveWorkbook.Close SaveChanges:=False
End Sub

would be my guess at something close to what you want.  Some of your instructions were not totally clear.  I copying each column in the range D1:Z100 to B1 of the same workbook.   I assume that is where it should be pasted.   Change names and so forth to reflect you actual situation.  

If would change D1:Z100 to something like D1:E100  to test it to see if it does what you want.  

Tom Ogilvy

---------- FOLLOW-UP ----------


It works perfect, except that the new workbook (sh3 in your code) does not get saved in the same folder as bk1. Instead it is getting saved one level higher up in the directory.

In other words the path to where sh3 is getting saved is folder1>sh3.

But I want it saved to folder1>folder2>sh3. Which is the same folder where bk1 is located.

What do I need to change to achieve this?

Thanks for your help!



this is where the path is established

Set bk1 = ThisWorkbook
sPath = bk1.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

bk1.path  gives the path where bk1 is located.  

I then save the workbook with

ActiveWorkbook.SaveAs sPath & sh1.Range("B1").Text

So I am saving it to the same folder as the workbook with the code is saved to.  Possibly you save the source workbook to a subfolder after you run my macro.  If so, you need to do it prior to running my macro. (but that is just a guess)

test this code (placed in  your workbook with worksheet1 and worksheet2)

sub tester1()
msgbox thisworkbook.Path
End Sub

that should show you where the file will be saved.  It that isn't the right location well . . .

That is the only option I have.  I am saving the new workbooks where the workbook with the code is located.  I have assumed you put the code in the workbook that has worksheet1 and worksheet2.  Since the rest of the code works - then that must be a good assumption.

Here is a demo from the immediate window:
? activeworkbook.FullName
spath = activeworkbook.Path
if Right(sPath, 1) <> "\" then spath = sPath & "\"
? sPath

so if I changed the focus to another workbook  and did

Activeworkbook.SaveAs SPath & "dog.xlsx"

it would be saved as

So if the Path of the workbook with the code is not where you want the file, then there is no way for me to know where you want the file.   

Tom Ogilvy

---------- FOLLOW-UP ----------


Yes, I got it to work! I have been dragging and dropping Workbook1 between different folders, which caused the problem. When I SaveAs Workbook1 to a specific folder, then the new worksheets also end up in that folder.

I have a supplementary question: how do I save the new worksheets to another folder (called "results") which is located in the same folder as Workbook1?

Also, can you direct me to a good book/source of information about Excel VBA for beginners? Whilst I am an Excel prof, I have never delved into VBA..

Many thanks



In the place where the code has

Set bk1 = ThisWorkbook
sPath = bk1.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

you would add a line

Set bk1 = ThisWorkbook
sPath = bk1.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPath = sPath & "results\"

then if spath was equal to

it would become


Notice I appended "results\" rather than "results"

you want the path to end with a "\"  so you can later append the new file name.

Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 All rights reserved.