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
                ' Find the last row with data on the summary worksheet.
            Last = DstWks.Range("B65536").End(xlUp).Row
             
            If Last = 1 Then
             Temp = Last + 1
             Else
             Temp = Last
            End If
            
            ' k was 6 ?
            k = 1
            
            If lSrcLastRow >= k Then
              ' For j = 0 To lSrcLastRow - k
                             
                ' Copy IOT
                DstWks.Cells(Temp + 1, "A").Value = IMTWks.Cells(5, "E").Value
               ' Copy IMT
                DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "F").Value
                'Account Name
                DstWks.Cells(Temp + 1, "C").Value = IMTWks.Cells(5, "B").Value
                'Account Segment
                DstWks.Cells(Temp + 1, "D").Value = IMTWks.Cells(5, "G").Value
                ' Lead Industry
                DstWks.Cells(Temp + 1, "E").Value = IMTWks.Cells(5, "D").Value
                MsgBox IMTWks.Cells(5, "E").Value
                ' Lead Sector
                DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "C").Value
                
                Temp = DstWks.Range("B65536").End(xlUp).Row
              ' Next
               ' Specify the range to place the data.
            
               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
            ' Now we will close the open file and clean
            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

Summary:
Author:
Mode:
Body: