Copy and paste the data from one worksheet into one giant worksheet?
When I do this stuff, I'm usually working with values. I don't want the
formulas. I don't want to worry about duplicate range names. So I'll just
copy|paste special|values.
If that sounds ok to you, maybe this macro would work nicely, too. (copy all
your workbooks in a dedicated folder. The macro will open all that it finds.
And it copies A1 through the last used cell of the first worksheet in the
workbook.
Option Explicit
Sub testme01()
Application.ScreenUpdating = False
Dim myFiles() As String
Dim fCtr As Long
Dim iCtr As Long
Dim myFile As String
Dim myPath As String
Dim tempWks As Worksheet
Dim AllWks As Worksheet
Dim oRow As Long
Dim rngToCopy As Range
Dim dummyRng As Range
Set AllWks = Workbooks.Add(1).Worksheets(1)
AllWks.Name = "All_" & Format(Date, "yyyymmdd_hhmmss")
oRow = 1
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If
'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop
If fCtr > 0 Then
For iCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar _
= "Processing: " & myFiles(iCtr) & " at: " & Now
Set tempWks = Nothing
On Error Resume Next
Application.EnableEvents = False
Set tempWks = Workbooks.Open(Filename:=myPath & myFiles(iCtr), _
ReadOnly:=True, UpdateLinks:=0).Worksheets(1)
Application.EnableEvents = True
If tempWks Is Nothing Then
MsgBox "couldn't open: " & myPath & myFiles(iCtr)
Else
With tempWks
Set dummyRng = .UsedRange 'try to reset usedrange
Set rngToCopy = .Range("a1", .UsedRange)
End With
rngToCopy.Copy
AllWks.Cells(oRow, "A").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
oRow = oRow + rngToCopy.Rows.Count
tempWks.Parent.Close SaveChanges:=False
End If
Next iCtr
AllWks.UsedRange.Columns.AutoFit
Else
AllWks.Parent.Close SaveChanges:=False
End If
With Application
.ScreenUpdating = True
.StatusBar = False
End With
End Sub