Solved

EXCEL TRANSPOSE AND CREATE NEW WORKBOOK WITH FORMAT

Posted on 2013-12-08
4
387 Views
Last Modified: 2013-12-09
Hi,

I need to create a new workbook (or several workbooks) with the data showed in the attached file: "WOKBOOK DATA".

The goal is to create a single sheet (Or workbook) for EACH row with information from WORKBOOK DATA (starting at row 7) with the format that you could see in the other attached file here called "RESULT".

WORKBOOK DATA contains in Row 6 the Titles that Must go in column A in the RESULT file... and the information located in row 7 at WORKBOOK DATA (and next rows) must go in column B.

The simple file RESULT has the target range, where the information must go, highligthed in yellow.

I appreciatte your help and time,

Regards,
Roberto.
WORKBOOK-DATA.xls
RESULT.xls
0
Comment
Question by:Pabilio
  • 2
  • 2
4 Comments
 
LVL 80

Expert Comment

by:byundt
ID: 39705160
Roberto,
Here is a macro that will create a new workbook, then add detail worksheets for each row of data in worksheet LISTA DE PRECIOS. It will name those detail worksheets after the Name value from column B. Worksheet names are truncated to 31 characters and / (illegal character in worksheet names) is replaced with _. As written, the macro assumes a template worksheet named Detail Template is located in the workbook containing the macro.
Sub DetailSheets()
Dim ws As Worksheet, wsMaster As Worksheet, wsTemplate As Worksheet
Dim rg As Range, rw As Range
Dim wb As Workbook
Dim i As Integer, n As Integer
Application.ScreenUpdating = False
Set wsMaster = Worksheets("LISTA DE PRECIOS")       'Get data from this worksheet
Set wsTemplate = Worksheets("Detail Template")      'Make a copy of this worksheet as a detail sheet for each row in wsMaster
Set wb = Workbooks.Add                              'Detail sheets will go here
n = wb.Worksheets.Count
With wsMaster
    Set rg = .Range("A7")       'First datum to be listed on detail sheet
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp)) 'All the data in that column
    Set rg = Intersect(.UsedRange, rg.EntireRow) 'All the data, all columns
End With
For Each rw In rg.Rows
    wsTemplate.Copy After:=wb.Worksheets(wb.Worksheets.Count)
    Set ws = ActiveSheet
    With ws
        .Name = Replace(Left(rw.Range("B1").Value, 31), "/", "_")
        .Range("B7:B9").Value = Application.Transpose(rw.Range("A1:C1").Value)
        .Range("B12:B33").Value = Application.Transpose(rw.Range("D1:Y1").Value)
    End With
Next
Application.DisplayAlerts = False
For i = 3 To 1 Step -1
    wb.Worksheets(i).Delete
Next
Application.DisplayAlerts = True
End Sub

Open in new window

Brad
WORKBOOK-DATA-Q28313448.xls
0
 
LVL 5

Author Comment

by:Pabilio
ID: 39705241
Dear Brad,

Hi Brad,

Thank you VERY much for your help... it Works exactly as I need and it will help me A LOT in my daily work.

There is only a Little detail and I'm not sure if it is for Excel 2003 limitations or what.

The code runs perfectly untill row 118... so it creates 111 sheets as I need but then it crash and shows the error message 1004 (error in method copy of the object _worksheet)

I tried deleting row 118 in case there was a problem with names or values on that row but it happens anyway.

I could live doing two steps to have all files done, but if you know how to fix this bug please just let me know.

Thanks again for this REALLY great work.

Roberto.
0
 
LVL 80

Accepted Solution

by:
byundt earned 500 total points
ID: 39705419
Roberto,
I can reproduce the error using Excel 2003 at my end. I assume it has to do with memory management. As a workaround, I revised the code to create a new workbook every 100 detail worksheets.

For future reference, it is a always a good idea to post the version of Excel that you are using when you ask a question. That lets people like me test the code in your version, and direct the discussion in more relevant fashion.

Brad

Sub DetailSheets()
Dim ws As Worksheet, wsMaster As Worksheet, wsTemplate As Worksheet
Dim rg As Range, rw As Range
Dim wb As Workbook
Dim i As Integer, n As Integer
Application.ScreenUpdating = False
Set wsMaster = Worksheets("LISTA DE PRECIOS")       'Get data from this worksheet
Set wsTemplate = Worksheets("Detail Template")      'Make a copy of this worksheet as a detail sheet for each row in wsMaster
Set wb = Workbooks.Add                              'Detail sheets will go here
n = wb.Worksheets.Count
With wsMaster
    Set rg = .Range("A7")       'First datum to be listed on detail sheet
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp)) 'All the data in that column
    Set rg = Intersect(.UsedRange, rg.EntireRow) 'All the data, all columns
End With
For Each rw In rg.Rows
    i = i + 1
    wsTemplate.Copy After:=wb.Worksheets(wb.Worksheets.Count)
    Set ws = ActiveSheet
    With ws
        .Name = Replace(Left(rw.Range("B1").Value, 31), "/", "_")
        .Range("B7:B9").Value = Application.Transpose(rw.Range("A1:C1").Value)
        .Range("B12:B33").Value = Application.Transpose(rw.Range("D1:Y1").Value)
    End With
    
    'In Excel 2003, observed an error when trying to process detail worksheet 111. Start new workbook as workaround.
    If i = 100 Then
        Application.DisplayAlerts = False
        For i = 3 To 1 Step -1
            wb.Worksheets(i).Delete
        Next
        Application.DisplayAlerts = True
        i = 0
        Set wb = Workbooks.Add
    End If
Next

Application.DisplayAlerts = False
For i = 3 To 1 Step -1
    wb.Worksheets(i).Delete
Next
Application.DisplayAlerts = True
End Sub

Open in new window

WORKBOOK-DATA-Q28313448.xls
0
 
LVL 5

Author Closing Comment

by:Pabilio
ID: 39706077
Hi Brad,

I'm sorry for my mistake not posting the Excel versión.

Thank you very much for your time and support.

Best regards,
Roberto.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now