PDA

View Full Version : Error Copying Data



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!

geekgirlau
12-01-2009, 09:31 PM
Could you post a sample please? Your attachment does not contain any data.

alliejane
12-02-2009, 05:15 AM
Sorry about that. I'm attaching a second spreadsheet called "use to recreate log.xls" -- it's the template that the users fill in.

xld
12-02-2009, 05:34 AM
Sub CopyData()
Dim arrFiles, FileCount As Long
Dim DestBook As Workbook, SrcBook As Workbook
Dim DestSheet As Worksheet, SrcSheet As Worksheet
Dim DestRange As Range, SrcRange As Range
Dim FinalRow As Long
'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
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
End With
Next

Application.ScreenUpdating = True

End Sub