Paste: whackness
Author: | drpepper |
Mode: | vbscript |
Date: | Tue, 25 Oct 2011 23:01:41 |
Plain Text |
Private Sub cbConsolidateOpportunities_Click()
Dim Folder As String, File As String
Dim lSrcLastRow As Long
Dim Last As Long
Dim Temp As Long
Dim SrcRows As Long
Dim CopyRng As Range
Dim SrcWkb As Workbook
Dim objXls As Object
Dim objWrkBk As Object
Dim DstWks As Worksheet
Dim SrcWks As Worksheet
Dim IMTWks As Worksheet
Dim logWks As Worksheet
Dim lLogLastRow As Long
Folder = ThisWorkbook.Path
With Application.FileSearch
.LookIn = Folder
.filename = "*Account Planning Template*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute
If .Execute > 0 Then
Set DstWks = ThisWorkbook.Worksheets("Consolidated")
Set logWks = ThisWorkbook.Worksheets("Log")
On Error GoTo ErrSub
For i = 1 To .FoundFiles.Count
File = .FoundFiles(i)
Set SrcWkb = Workbooks.Open(.FoundFiles(i))
Set SrcWks = SrcWkb.Worksheets("Opportunities")
Set IMTWks = SrcWkb.Worksheets("Account Financials")
lSrcLastRow = Worksheets("Opportunities").Range("D65536").End(xlUp).Row
Last = DstWks.Range("B65536").End(xlUp).Row
If Last = 1 Then
Temp = Last + 1
Else
Temp = Last
End If
k = 1
If lSrcLastRow >= k Then
DstWks.Cells(Temp + 1, "A").Value = IMTWks.Cells(5, "E").Value
DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "F").Value
DstWks.Cells(Temp + 1, "C").Value = IMTWks.Cells(5, "B").Value
DstWks.Cells(Temp + 1, "D").Value = IMTWks.Cells(5, "G").Value
DstWks.Cells(Temp + 1, "E").Value = IMTWks.Cells(5, "D").Value
MsgBox IMTWks.Cells(5, "E").Value
DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "C").Value
Temp = DstWks.Range("B65536").End(xlUp).Row
If Last = 1 Then
Last = Last + 1
End If
Set CopyRng = SrcWks.Range("B6:N" & lSrcLastRow)
CopyRng.Copy
With DstWks.Cells(Last + 1, "G")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
lLogLastRow = logWks.Range("A65536").End(xlUp).Row
Dim p As Integer
If i = 1 Then p = 2 Else p = 1
logWks.Cells(lLogLastRow + p, "A").Value = .FoundFiles(i)
logWks.Cells(lLogLastRow + p, "B").Value = "Success"
ElseIf lSrcLastRow = 5 Then
lLogLastRow = logWks.Range("A65536").End(xlUp).Row
If i = 1 Then p = 2 Else p = 1
logWks.Cells(lLogLastRow + p, "A").Value = .FoundFiles(i)
logWks.Cells(lLogLastRow + p, "B").Value = "Success"
End If
SrcWkb.Close savechanges:=False
fileloop: Next
ThisWorkbook.Save
End
ErrSub:
MsgBox "Error happened and logging the Account " + File + " : " + Err.Description
lLogLastRow = logWks.Range("A65536").End(xlUp).Row
If i = 1 Then p = 2 Else p = 1
logWks.Cells(lLogLastRow + p, "A").Value = File
logWks.Cells(lLogLastRow + p, "B").Value = "Failed"
SrcWkb.Close savechanges:=False
Resume fileloop:
End If
End With
End Sub
New Annotation