Copying a worksheet and pasting into new workbook 1

[stephenmbell]

I have 25 excel sheets that I dynamically create by exporting data from Access.

Each of the 25 files consist of 1 sheet each (sheet 2 and 3 exists, but contain no data and do not concern me)

Using VBA I would like to:

- Create a new workbook (AllData.xls) (I have this part done)

For Each of the 25 files
copy worksheet1
and paste worksheet1 into alldata.xls (into a new worksheet)

So that at the end of this code I will have the original 25 files and a new file that contains 25 worksheets or tabs, containing the data that is in the 25 files.

So far I can loop through all of the files, open them, and access their data.

I am having trouble with the actual copy / paste.

I have been toying with worksheet.copy and worksheet.paste methods, but I cannot seem to get it to work.

Hope this post is straight forward enough.

Any help is greatly appreciated.

Thanks

sb

 

[PHV]

What is your actual code ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[stephenmbell]

Here it is..

'declare local variables
'objects for working with the file system
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File

Dim appExcel As Excel.Application
Dim wbkDistrict As Excel.Workbook
Dim wksDistrict As Excel.Worksheet
Dim wbkAll As Excel.Workbook
Dim wksAll As Excel.Worksheet
Dim nWorkSheetCounter As Integer
Dim rng As Excel.Range
Dim strFileName As String

' set to break on all errors
Application.SetOption "Error Trapping", 0

strFileName = "AllDistricts.xls"

Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(cPathToFiles)

' Create the Excel Applicaiton, Workbook and Worksheet
Set appExcel = New Excel.Application
Set wbkAll = appExcel.Workbooks.Add

'save the workbook (all)
strFileName = cPathToFiles & strFileName
wbkAll.SaveAs FileName:=strFileName
wbkAll.Close

Set wbkAll = appExcel.Workbooks.Open(strFileName)
Set wksAll = appExcel.Worksheets(cTabOne)

'initialize the counter
nWorkSheetCounter = cTabOne

'for every district workbook
For Each objFile In objFolder.Files
  
  'for every file except alldistricts.xls
  If objFile.Name <> "AllDistricts.xls" Then
    'open the district file
    Set wbkDistrict = appExcel.Workbooks.Open(cPathToFiles & objFile.Name)
    Set wksDistrict = wbkDistrict.Worksheets(cTabOne)
    'copy the district worksheet    
    wksDistrict.Copy
    'paste to all workbook
    wksDistrict.Paste wbkAll
    'close the wksDistrict
    wbkDistrict.Save
    wbkDistrict.Close
    'name the worksheet
    If nWorkSheetCounter < 10 Then
      wksAll.Name = "700" & nWorkSheetCounter
    Else
      wksAll.Name = "70" & nWorkSheetCounter
    End If
    
    'add a worksheet to workbook (all)
    wbkAll.Worksheets.Add , nWorkSheetCounter
    'save
    wbkAll.Save
    nWorkSheetCounter = nWorkSheetCounter + 1
  End If
    
Next

'close the all workbook
wbkAll.Close
appExcel.Quit

MsgBox "done"

Set wbkAll = Nothing
Set wksAll = Nothing
Set wbkDistrict = Nothing
Set wksDistrict = Nothing
Set appExcel = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

 

[PHV]

you may try this:

...
For Each objFile In objFolder.Files
  If objFile.Name <> "AllDistricts.xls" Then
    Set wbkDistrict = appExcel.Workbooks.Open(cPathToFiles & objFile.Name)
    wbkDistrict.Worksheets(cTabOne).Cells.Copy wksAll.Range("A1")
    wbkDistrict.Close False
    If nWorkSheetCounter < 10 Then
      wksAll.Name = "700" & nWorkSheetCounter
    Else
      wksAll.Name = "70" & nWorkSheetCounter
    End If
    wbkAll.Save
    Set wksAll = wbkAll.Worksheets.Add
    wbkAll.Save
    nWorkSheetCounter = nWorkSheetCounter + 1
  End If
Next
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886