Macro Code problem

dolphn22

Board Regular
Joined
Aug 22, 2008
Messages
82
Hi all,

I was provided code to go to a folder and combine the tabs in each file and put into one workbook, one worksheet. It works to the point where it opens the first file, and copies, but then does not paste and won't complete. It gets stuck at the line bolded below. Any help here would be greatly appreciated. Thank you gentleman!


Dolphn22


Sub Macro()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
ThisWB = ActiveWorkbook.Name
path = ("C:\Users\derbert\Desktop\Combined")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets("Upload File")
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy
Sheets("Upload File").Select
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close False
End If
Filename = Dir()
Loop

Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
The problem is that the "Upload File" sheet is not in the active workbook. Preface it with "Workbooks(ThisWB)" or use shtDest.Select.
 
Upvote 0
Thank you for your quick response. So that line should look like this?

Workbooks(ThisWB) Sheets("Upload File").Select

I am still learning about macros, so I apologize in advance for having to ask.
 
Upvote 0
Close. Need a "." before Sheets

Workbooks(ThisWB).Sheets("Upload File").Select


You need to tell it which workbook to find the sheet in
 
Upvote 0
OK, so I tried the line of code above exactly how you had it, and also tried it where it says "This WB", I changed it to the workbook name, and neither worked, it still hung up at that point. Do you have any ideas?
 
Upvote 0
What is the error given?

Maybe try Activate instead of Select

Workbooks(ThisWB).Sheets("Upload File").Activate
 
Upvote 0

Forum statistics

Threads
1,214,720
Messages
6,121,121
Members
449,013
Latest member
JerrExcel

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
Back
Top