Help with VBA - copy and paste workbooks into worksheets.

jmazorra

Well-known Member
Joined
Mar 19, 2011
Messages
707
Hello folks:

I had a user helped me with the following code:

Sub copyByBand()
Dim sFile As String
Dim sFileToOpen As String

sFile = "2011.1004.Salary Survey Template.xlsm"
sFileToOpen = Workbooks(sFile).Path & "\byband.csv"

If Len(Dir(sFileToOpen)) > 0 Then
With Workbooks.Open(sFileToOpen)
.Worksheets(1).Cells.Copy Workbooks(sFile).Worksheets("byband").Range("A1")
.Close savechanges:=False
End With
End With
End Sub

I now need to add 4 more workbooks: byemployee.csv; byposition.csv; status report.xls; bydepartment.csv. I then need to paste those workbooks into worksheets by the same name in workbook 2011.1004.Salary Survey Template.xlsm

Thanks
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

pboltonchina

Well-known Member
Joined
Apr 24, 2008
Messages
1,095
Try this on a copy of your data
'Combine Workbooks
'By Tommy Miles
'This sample goes through all the Excel files in a specified directory and combines theminto
'a single workbook. It renames the sheets based on the name of the original workbook:
Sub CombineWorkbooks()
Dim CurFile As String, DirLoc As String
Dim DestWb As Workbook
Dim WS As Object 'allows for different sheet types


DirLoc = ThisWorkbook.path & "\tst\" 'location of files
CurFile = Dir(DirLoc & "*.xls")


Application.ScreenUpdating = False
Application.EnableEvents = False


Set DestWb = Workbooks.Add(xlWorksheet)


Do While CurFile <> vbNullString
Dim OrigWb As Workbook
Set OrigWb = Workbooks.Open(filename:=DirLoc & CurFile, ReadOnly:=True)

' Limit to valid sheet names and remove .xls*
CurFile = Left(Left(CurFile, Len(CurFile) - 5), 29)

For Each WS In OrigWb.Sheets
WS.Copy After:=DestWb.Sheets(DestWb.Sheets.count)

If OrigWb.Sheets.count > 1 Then
DestWb.Sheets(DestWb.Sheets.count).Name = CurFile & WS.Index
Else
DestWb.Sheets(DestWb.Sheets.count).Name = CurFile
End If
Next

OrigWb.Close SaveChanges:=False
CurFile = Dir
Loop


Application.DisplayAlerts = False
DestWb.Sheets(1).Delete
Application.DisplayAlerts = True


Application.ScreenUpdating = True
Application.EnableEvents = True


Set DestWb = Nothing


End Sub

Hello folks:

I had a user helped me with the following code:



I now need to add 4 more workbooks: byemployee.csv; byposition.csv; status report.xls; bydepartment.csv. I then need to paste those workbooks into worksheets by the same name in workbook 2011.1004.Salary Survey Template.xlsm

Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,122,335
Messages
5,595,573
Members
413,996
Latest member
mabelO

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top