alliejane
12-01-2009, 05:23 PM
Situation:
I have a worksheet that users complete. They press a button and it logs the necessary information to a log sheet, as well as saving the worksheet with a unique name so that they can go back and look at it, if needed.
Problem:
A user messed up the template and nothing has been logged to the log sheet for a few months. However, the worksheets have been saved with the unique names.
I would like to recreate the log without having to go into each of the individually saved worksheets (there are upward of 1000 of the worksheets, in about 7 different network folders). The worksheets are all 2003 worksheets - and the data that is needed is on Sheet2 of the worksheet.
I am attaching a worksheet with the macro I'm working on to recreate the sheet. The beginning section allows me to select a group of worksheets - I can get through that part. However, as soon as I select a worksheet, I get an error that I can't seem to fix.
Sub CopyData()
Dim arrFiles, FileCount As Long
Dim SrcBook As Workbook
Dim DestSheet As Worksheet, SrcSheet As Worksheet
Dim DestRange As Range, SrcRange As Range
'Definition of DestSheet is to be modified as appropriate
Application.ScreenUpdating = False
Set DestSheet = ThisWorkbook.Sheets(1)
'Prompting the user for files. Multiple files can be selected, even 20 at a time.
arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xls), *.xls", , "Select the files for processing", , True)
'Loop through the files
For FileCount = 1 To UBound(arrFiles)
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
On Error Resume Next
Set DestBook = ThisWorkbook.Sheets(1)
If Err.Number = 1004 Then
Set DestBook = Workbooks.Add
End If
On Error GoTo 0
With DestBook.Worksheets(1)
FinalRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set SrcBook = Workbooks.Open(arrFiles(FileCount))
'Definition of SrcSheet is to be modified as appropriate
Set SrcSheet = SrcBook.Sheets(2)
SrcBook.Worksheets(2).Range("Name").Copy
DestBook.Worksheets(1).Range("A" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Mgr").Copy
DestBook.Worksheets(1).Range("B" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Clm_Num").Copy
DestBook.Worksheets(1).Range("C" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("DOR").Copy
DestBook.Worksheets(1).Range("D" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Overall_Score").Copy
DestBook.Worksheets(1).Range("E" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Coverage").Copy
DestBook.Worksheets(1).Range("F" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Investigation").Copy
DestBook.Worksheets(1).Range("G" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Communication").Copy
DestBook.Worksheets(1).Range("H" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Evaluation").Copy
DestBook.Worksheets(1).Range("I" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Damage_Assessment").Copy
DestBook.Worksheets(1).Range("J" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Vendor_Mgmt").Copy
DestBook.Worksheets(1).Range("K" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Negotiation_Direction").Copy
DestBook.Worksheets(1).Range("L" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Contact_24Hrs").Copy
DestBook.Worksheets(1).Range("M" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Documentation").Copy
DestBook.Worksheets(1).Range("N" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Data_Integrity").Copy
DestBook.Worksheets(1).Range("O" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Possible").Copy
DestBook.Worksheets(1).Range("P" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("percent").Copy
DestBook.Worksheets(1).Range("Q" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("rating").Copy
DestBook.Worksheets(1).Range("R" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
Next
End With
Application.ScreenUpdating = True
End Sub
Any help would be so appreciated.
Thanks!
I have a worksheet that users complete. They press a button and it logs the necessary information to a log sheet, as well as saving the worksheet with a unique name so that they can go back and look at it, if needed.
Problem:
A user messed up the template and nothing has been logged to the log sheet for a few months. However, the worksheets have been saved with the unique names.
I would like to recreate the log without having to go into each of the individually saved worksheets (there are upward of 1000 of the worksheets, in about 7 different network folders). The worksheets are all 2003 worksheets - and the data that is needed is on Sheet2 of the worksheet.
I am attaching a worksheet with the macro I'm working on to recreate the sheet. The beginning section allows me to select a group of worksheets - I can get through that part. However, as soon as I select a worksheet, I get an error that I can't seem to fix.
Sub CopyData()
Dim arrFiles, FileCount As Long
Dim SrcBook As Workbook
Dim DestSheet As Worksheet, SrcSheet As Worksheet
Dim DestRange As Range, SrcRange As Range
'Definition of DestSheet is to be modified as appropriate
Application.ScreenUpdating = False
Set DestSheet = ThisWorkbook.Sheets(1)
'Prompting the user for files. Multiple files can be selected, even 20 at a time.
arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xls), *.xls", , "Select the files for processing", , True)
'Loop through the files
For FileCount = 1 To UBound(arrFiles)
Application.ScreenUpdating = False
Set SrcBook = ThisWorkbook
On Error Resume Next
Set DestBook = ThisWorkbook.Sheets(1)
If Err.Number = 1004 Then
Set DestBook = Workbooks.Add
End If
On Error GoTo 0
With DestBook.Worksheets(1)
FinalRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set SrcBook = Workbooks.Open(arrFiles(FileCount))
'Definition of SrcSheet is to be modified as appropriate
Set SrcSheet = SrcBook.Sheets(2)
SrcBook.Worksheets(2).Range("Name").Copy
DestBook.Worksheets(1).Range("A" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Mgr").Copy
DestBook.Worksheets(1).Range("B" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Clm_Num").Copy
DestBook.Worksheets(1).Range("C" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("DOR").Copy
DestBook.Worksheets(1).Range("D" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Overall_Score").Copy
DestBook.Worksheets(1).Range("E" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Coverage").Copy
DestBook.Worksheets(1).Range("F" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Investigation").Copy
DestBook.Worksheets(1).Range("G" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Communication").Copy
DestBook.Worksheets(1).Range("H" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Evaluation").Copy
DestBook.Worksheets(1).Range("I" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Damage_Assessment").Copy
DestBook.Worksheets(1).Range("J" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Vendor_Mgmt").Copy
DestBook.Worksheets(1).Range("K" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Negotiation_Direction").Copy
DestBook.Worksheets(1).Range("L" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Contact_24Hrs").Copy
DestBook.Worksheets(1).Range("M" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Documentation").Copy
DestBook.Worksheets(1).Range("N" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Data_Integrity").Copy
DestBook.Worksheets(1).Range("O" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("Possible").Copy
DestBook.Worksheets(1).Range("P" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("percent").Copy
DestBook.Worksheets(1).Range("Q" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
SrcBook.Worksheets(2).Range("rating").Copy
DestBook.Worksheets(1).Range("R" & FinalRow + 1).PasteSpecial Paste:=xlPasteValues
Next
End With
Application.ScreenUpdating = True
End Sub
Any help would be so appreciated.
Thanks!