?
Solved

Excel-VBA (Copy Header-Updated)

Posted on 2011-04-18
14
Medium Priority
?
431 Views
Last Modified: 2012-05-11
The following code allows me to copy five rows from a source file to 120 files within a folder.  Please help me update the code so that the column formats are also copied over to the120 files.

Here is the code.
Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 15.xls"

Dim oXL, oFolder, aFile, FSO
Dim wb1, wb2, ws1, ws2

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath  & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = true
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = false
Set wb1 = nothing
Set ws1 = nothing
Set wb2 = nothing
Set ws2 = nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
Msgbox "Done"
0
Comment
Question by:ArisaAnsar
  • 7
  • 7
14 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35419781
Try this

Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 15.xls"

Dim oXL, oFolder, aFile, FSO, colns
Dim wb1, wb2, ws1, ws2
Dim MyArray()

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = "1,4,7"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)
            ws2.Columns(Val(MyArray(i))).EntireColumn.Hidden = True
        Next i
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"

Open in new window


Sid
0
 

Author Comment

by:ArisaAnsar
ID: 35419832
I'm getting the attached error message.  See screenshot attached.

Here is the entire code I have:
Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 15.xls"

Dim oXL, oFolder, aFile, FSO, colns
Dim wb1, wb2, ws1, ws2
Dim MyArray()

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = "1,4,7"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)
            ws2.Columns(Val(MyArray(i))).EntireColumn.Hidden = True
        Next i
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"

Doc3.doc
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35419836
Checking

Sid
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35419845
Change this line

Dim MyArray()

to

Dim MyArray

Now try it.

Sid
0
 

Author Comment

by:ArisaAnsar
ID: 35419871
it did not help.  I'm still getting the same error message. Where am I going wrong?

Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 15.xls"

Dim oXL, oFolder, aFile, FSO, colns
Dim wb1, wb2, ws1, ws2
Dim MyArray

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = "1,4,7"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)
            ws2.Columns(Val(MyArray(i))).EntireColumn.Hidden = True
        Next i
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35419916
Just created sample file. testing it.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35419979
Try this

Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports Test\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 15.xls"

Dim oXL, oFolder, aFile, FSO, colns, i
Dim wb1, wb2, ws1, ws2
Dim MyArray

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = "1,4,7"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)-1
            msgbox trim(MyArray(i+1))
			ws2.Columns(CLng(trim(MyArray(i+1)))).EntireColumn.Hidden = True
        Next 
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"

Open in new window


Sid
0
 

Author Comment

by:ArisaAnsar
ID: 35420055
Sid,
That worked but it makes me click "OK" on each colum I'm hiding on each spreadsheet.  Can you remove the prompt where it makes me click on OK?

If it remains, my Carpal Tunnel Syndrome is going to get worst ;-).

Doc4.doc
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35420058
Oops...

Please delete line 29 :)

msgbox trim(MyArray(i+1))

Sid
0
 

Author Closing Comment

by:ArisaAnsar
ID: 35420096
WOOOHOOO!!! Thank you, Thank you!  That worked.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35420102
Glad to be of help :)

BTW, I have answered your other query as well :)

Sid
0
 

Author Comment

by:ArisaAnsar
ID: 35420114
You're more than help!  You are a life saver.   I'm looking at the other post now. Will let you know in a few minutes.
0
 

Author Comment

by:ArisaAnsar
ID: 35720780
Hi Sid,
For some reason, the part of the code to hide certain columns are not working correctly.   Below is the updated code with the columns to hide.  However, its hiding one more column than it should.  Right now its hiding column "S" (#20) on the spreadsheet and I don't want it hidden.  What am I doing wrong?

Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report April 29.xls"

Dim oXL, oFolder, aFile, FSO, colns, i
Dim wb1, wb2, ws1, ws2
Dim MyArray

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = ",7,8,10,11,13,14,16,17,22,24,30"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)-1
                  ws2.Columns(CLng(trim(MyArray(i+1)))).EntireColumn.Hidden = True
        Next
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"
31-WEST-52ND-ST.xls
0
 

Author Comment

by:ArisaAnsar
ID: 35773247
Sid,
I changed this macro slightly to have more columns hidden but for some reason the correct columns are not being hidden.  What am I doing wrong?  I attached a file of the columns that are being hidden instead of those I have identified in the code below.

Here is the updated code which you helped me with in the past:

Const MyPath = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Complex Reports\" '<~~ Folder where the files are
Const SourceFile = "T:\Jennifer\Beyond Now - CSAs Beyond NOW\Connect Reports\Connect - CSA Engagement Report 5-15.xls"

Dim oXL, oFolder, aFile, FSO, colns, i
Dim wb1, wb2, ws1, ws2
Dim MyArray

'~~> Enter the column Numbers here separated with a comma
'~~> that you want to hide
colns = ",7,8,10,11,12,13,14,15,16,17,19,20,25,27,28,34,35"

MyArray = Split(colns, ",", -1, 1)

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb1 = oXL.Workbooks.Open(SourceFile)
Set ws1 = wb1.Sheets("Complex")

For Each aFile In oFolder.Files
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb2 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws2 = wb2.Sheets("DESTINATION")
        oXL.Visible = True
        ws1.Rows("1:5").Copy ws2.Rows("1:5")
        For i = LBound(MyArray) To UBound(MyArray)-1
                  ws2.Columns(CLng(trim(MyArray(i+1)))).EntireColumn.Hidden = True
        Next
        wb2.Close True
    End If
Next
wb1.Close SaveChanges = False
Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing
MsgBox "Done"

31-WEST-52ND-ST.xls
0

Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

839 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