1

I'm using a VBA code to cycle through excel files in a directory and pull information from one worksheet and paste into a newly created worksheet. I'm also naming my new worksheets (in my destination file) by the name in one of the cells in the source file.

My code works for the first loop but fails/stops in the second loop (VBA points to an error in the Dest.Sheets.Add(After:=Dest.Sheets(Dest.Sheets.Count)).Name = Sheetname line. I need to loop through 75 of these files and I'm unsure of what's going on because it works correctly for the first file.

Thanks so much for the help!

Sub AddSummaryTables()

Dim Spath, Filename, Sheetname As String
Dim Source, Dest As Workbook
Dim WS As Worksheet
Set Dest = ThisWorkbook

Spath = InputBox("Enter File Source Path") & "\"
Filename = Dir(Spath & "*.xls*")

Do While Filename <> ""

Set Source = Workbooks.Open(Spath & Filename)
Sheetname = Source.Sheets("Summary").Range("B2").Text
MsgBox Sheetname
Dest.Sheets.Add(After:=Dest.Sheets(Dest.Sheets.Count)).Name = Sheetname
Source.Sheets("Summary").Range("A1:R150").Copy
Dest.Worksheets(Sheetname).Range("A1").PasteSpecial xlPasteValues
Dest.Worksheets(Sheetname).Range("A1").PasteSpecial xlPasteFormats

Dest.Worksheets(Sheetname).Range("A1:R150").WrapText = False
Dest.Worksheets(Sheetname).Rows.AutoFit
Dest.Worksheets(Sheetname).Columns.AutoFit
Source.Close SaveChanges:=False
Dest.Save

Filename = Dir()
Loop

End Sub
Community
  • 1
  • 1
vs723
  • 13
  • 3
  • What is the error? Have you checked to see if you have duplicate names? – Comintern Mar 27 '16 at 01:02
  • Just checked my errors. It looks like my sheetnames exceeded the maximum permissible characters-which caused my code to crash. I've got it fixed now and it works great! Thanks so much! – vs723 Mar 28 '16 at 16:04

2 Answers2

2

following Comintern's and Wyatt's suggestion you could try like follows

Option Explicit

Sub AddSummaryTables()

Dim sPath As String, fileName As String
Dim sourceWb As Workbook, destWb As Workbook
Dim sourceWs As Worksheet, destWs As Worksheet

Set destWb = ThisWorkbook

sPath = InputBox("Enter File Source Path") & "\"
fileName = Dir(sPath & "*.xls*")

Do While fileName <> ""

    Set sourceWb = Workbooks.Open(sPath & fileName)
    Set sourceWs = GetWorksheet(sourceWb, "Summary")
    If Not sourceWs Is Nothing Then
        Set destWs = SetWorksheet(destWb, sourceWs.Range("B2").Text)

        sourceWs.Range("A1:R150").Copy
        With destWs
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
            .UsedRange.WrapText = False
            .Rows.AutoFit
            .Columns.AutoFit
        End With

        sourceWb.Close SaveChanges:=False

        destWb.Save

    End If

    fileName = Dir()
Loop

End Sub


Function GetWorksheet(wb As Workbook, sheetName As String) As Worksheet

On Error Resume Next
Set GetWorksheet = wb.Worksheets(sheetName)
On Error GoTo 0

End Function


Function SetWorksheet(wb As Workbook, sheetName As String) As Worksheet
Dim i As Integer

Do While Not GetWorksheet(wb, sheetName & IIf(i = 0, "", "-" & i)) Is Nothing
    i = i + 1
Loop

With wb
    .Worksheets.Add(After:=.Worksheets(.Worksheets.Count)).Name = sheetName & IIf(i = 0, "", "-" & Format(i, "000"))
    Set SetWorksheet = .ActiveSheet
End With

End Function

where you make sure that

  • any opened workbook has a "Summary" worksheet
  • you name worksheets in your destination workbook such as not to have duplicates: if you happen to deal with say three worksheets named "Sheet5" then your destination workbook will have added worksheets "Sheet5", "Sheet5-001" and "Sheet5-002".
user3598756
  • 28,893
  • 4
  • 18
  • 28
  • Thanks for the detailed response! I plugged in your functions and changed parts of my code and it's up and running now! Thanks a lot for the help! :) – vs723 Mar 28 '16 at 16:05
  • glad to be of help. If I answered your question please mark my answer as the solution. thank you – user3598756 Mar 28 '16 at 16:52
0

You're issue may be that when you are adding the sheet from the second workbook, it has the same name as the sheet from the first workbook. You could check if the sheet exists and add a number to it. The post below might help.

Test or check if sheet exists

Community
  • 1
  • 1
Wyatt Shipman
  • 1,669
  • 1
  • 10
  • 22
  • Thanks! It just so happened that the variables in my string were way to long to be used as sheetnames. I used a function to truncate the names and it worked like a charm! Thanks again for the helpful suggestions! – vs723 Mar 28 '16 at 16:02