Take the 2-minute tour ×
Stack Overflow is a question and answer site for professional and enthusiast programmers. It's 100% free, no registration required.

I am new to Excel VBA and need some help writing 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 used two days searching the net to find an answer without any luck....

share|improve this question
 
Please check range of columns it should be D1 : Z1 –  MarmiK Mar 12 '13 at 9:48
add comment

2 Answers

Start the way most of us did:

  1. Record new macro.
  2. Manually perform all the steps you want to automate.
  3. Stop recording.
  4. Go to the Developer tab and inspect the auto-generated code.
  5. Write your own VBA based on what you learn in Step 4.

You will have to figure out a few things on your own, or come back here and ask specific questions.

share|improve this answer
add comment
  1. I have not done any error handling.
  2. I am not 100% positive of your circumstances etc, so you have to test the code yourself
  3. Execute this macro on a copy of your files



Option Explicit
'
' Main Sub!
'
Sub MainSub()

    ' $references
    Dim wS           As Worksheet
    Dim wSS          As Worksheet
    Set wS = ThisWorkbook.Sheets(1)
    Set wSS = ThisWorkbook.Sheets(2)

    ' $variables
    Dim i           As Long

    With wS

        ' 4 = D, 26 = Z
        ' Column Count > Z  use ws.Cells(1, Columns.Count).End(xlToLeft).Column instead of 26
        For i = 4 To 26

            Call copyRanges(wS, Range(Cells(1, 4), Cells(100, 4)), Range("B1"))

            '
            '     *     fire your trigged calculation here
            '
            '     **    before another column is copied <- before Next
            '
            '     - IM ASSUMING  _YOU_  HAVE POPULATED YOUR     A1:B100   Worksheet2

            ' create a new book
            Call createNewBook(CStr(.Range("B1").Value), CStr(ThisWorkbook.Path))

            ' open that book
            Workbooks.Open (ThisWorkbook.Path & "\" & CStr(wS.Range("B1").Value) & ".xlsx")
            Workbooks(wS.Range("B1").Value).Activate

                With ActiveWorkbook
                    wSS.Activate
                    wSS.Range(wSS.Cells(1, 1), wSS.Cells(100, 2)).Select
                    Selection.Copy
                    Workbooks(wS.Range("B1").Value).Activate
                    Range("A1").Select
                    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                    Application.CutCopyMode = False
                End With

            ActiveWorkbook.Save
            ActiveWorkbook.Close


        Next
    End With

End Sub

'
' CopyRanges
' @ wS          -   sheet
' @ copyWhat    -   range to copy
' @ copyTo      -   paste at
'
Sub copyRanges(ByRef wS As Worksheet, copyWhat As Range, copyTo As Range)
    With wS
        copyWhat.Select
        Selection.Copy
        copyTo.Select
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        Application.CutCopyMode = False
    End With
End Sub

'
' createNewBook
' @ newWbName   -   Name
' @ wbPath      -   ThisWorkbook.Path
'
Sub createNewBook(newWbName As String, wbPath As String)

    ' create a new WorkBook object
    Dim NewBook As Workbook
    ' reference
    Set NewBook = Workbooks.Add

    With NewBook
        .SaveAs Filename:=wbPath & "\" & newWbName & ".xlsx"
    End With
End Sub
share|improve this answer
 
Thanks for that! I will try it now, and come back with comments! –  RobDK Mar 13 '13 at 7:57
 
no worries, im waiting for your feedback. Note: execute this macro on a copy of your original file –  mehow Mar 13 '13 at 8:00
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.