We help IT Professionals succeed at work.

Excel-VBA (Copy Header-Updated)

Medium Priority
460 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"
Comment
Watch Question

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

Author

Commented:
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
Checking

Sid
Change this line

Dim MyArray()

to

Dim MyArray

Now try it.

Sid

Author

Commented:
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"
Just created sample file. testing it.

Sid
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

Author

Commented:
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
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
WOOOHOOO!!! Thank you, Thank you!  That worked.
Glad to be of help :)

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

Sid

Author

Commented:
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.

Author

Commented:
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

Author

Commented:
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
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.