excel vba Must Save workbook in order to do another copy/paste

Looks like you should move the save outside of your loop.

Take these:


234        wbkNew.SaveAs Filename:=strCompletePathFilename
235        wbkNew.Close

and move them outside the processing loop:

line 141

Of course, that means that line 199 needs to be moved up before that loop (line 97, and remove line 98)

Finally, you'll need to pass wbkNew as a ByRef variable in the subroutine so that any changes are retained.

--
Is that enough to get you going?
If not, it would be much easier in this case if you attach a copy of the spreadsheet.


--
FYI
Instead of GetUserName, a simpler way to often handle this is simply: Environ("UserName")

@rspahitz: Yes, the problem I am having is with not saving and closing wbkNew with each iteration.  If I don't close it, I need to somehow activate it before pasting to it with the next iteration.  That's where I am having the problem - I can't get the syntax right and I keep getting the paste error.

I'll re-post a skimmed-down version of the code, along with the excel file.  Hopefully you can more easily see what's going on and you'll be able to help me figure out how to re-activate wbkNew - instead of having to close it each time through the loop.

Thanks for the other comments - I'll give them a try once I get the save/close issue resolved.

Private Sub CreateRCTExcelReportFile()
    
    Dim strReportFileName  As String 'E10 - New Report filename
    Dim strCompleteReportFileName As String  ' With date-time stamp
    Dim strInputFolder As String     'E6 - Input File Path
    Dim strNewFolder As String       'E12 save-to path for report
    Dim strCompletePathFilename As String    'Final path and filename with date-time stamps
    Dim strfilter As String
    Dim strDestSheet As String
    Dim i As Variant
    Dim arrayOfFiles() As Variant
    Dim strInputSheet As String
    Dim WB1 As Workbook
    Dim wbkNew As Workbook
    Dim strInputFile As String
    Dim strCopyRange As String
    Dim strPasteRange As String
    Dim strNewWkbk As String
    Dim strDelRng As String
    
        Worksheets("Main").Activate
        Set WB1 = ActiveWorkbook
   
   ' Initialize variables
   
    strReportFileName = Worksheets("Main").Range("E8")
    strInputFolder = Worksheets("Main").Range("E6")
    strNewFolder = Worksheets("Main").Range("E10")
    strfilter = "*.xls"
    
   'check for filename
    strCompleteReportFileName = strReportFileName & " " & Format(Now, "yyyymmdd hhmmss") & ".xls"
        If IsNull(strReportFileName) Or (strReportFileName) = "" Then MsgBox "Enter a valid filename for output file.", vbCritical, "Error - Report Parameters"
        If Left(strNewFolder, 1) <> "\" Then strNewFolder = strNewFolder & "\"
    strCompletePathFilename = strNewFolder & strCompleteReportFileName
    
    
    
    'create an array of customer account numbers
    arrayOfFiles = Array("809-618824", "809-618838", "827-618877")

   'create an array of input files
    Dim strArrayCustNums() As Variant
    
    strArrayCustNums = Array("RC-T Report OH Count 20110331200006 .xls", "RC-T Report 809-618838 20110331200006 .xls", "RC-T Report 809-618824 20110331200006 .xls", "RC-T Report 827-618877  20110331200006 .xls")
   
    'Create new report
 
    Set wbkNew = Workbooks.Add
    Application.DisplayAlerts = False
    wbkNew.Worksheets.Add.Name = "OH Count"
    wbkNew.SaveAs Filename:=strCompletePathFilename
    wbkNew.Close
       i = 0
       Dim UB As Integer
       UB = UBound(arrayOfFiles, 1)
       Do While i <= UB
        strInputSheet = arrayOfFiles(i)
            
            'Select Case (Left(strInputSheet, 22))
            Select Case (strInputSheet)
                    Case ("RC-T Report OH Count 2")
                        strDestSheet = "OH Count Collateral"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                        strInputFolder, strInputSheet, strCompletePathFilename)
                    Case Else
                        ' Load the customer account files
                        strDestSheet = strInputSheet
                        strCopyRange = "A:L"
                        strPasteRange = "A1"
                        strDelRng = "M:AX"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet, strCompletePathFilename, strDelRng)
               End Select
          i = i + 1
       Loop
        arrayOfFiles(i - 1) = strDestSheet

       
       'format report
'         Call formatReport(strCompletePathFilename, strNewFolder)
       'check for bad records in OH Count sheet
 '        Call testOHData(strNewFolder, strCompleteReportFileName)

'Housekeeping
    Set WB1 = Nothing
    Set wbkNew = Nothing
        Application.Cursor = xlDefault
End Sub


Public Function inputFileData(strDestSheet As String, strCopyRange As String, strPasteRange As String, _
                        strInputFolder As String, strInputSheet As String, _
                        strCompletePathFilename As String, Optional strDelRng As String) As Boolean
    
    Dim wbkInput As Workbook
    Dim wbkNew As Workbook
    Dim ws As Worksheet
    Dim wsht As Worksheet
    Dim flag As Boolean
    Dim cell1, cell2, rng As Range
    Dim checkSheet As Worksheet
    Dim myString As String

   Application.ScreenUpdating = False
     
  ' COPY INPUT FILE
   Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet & ".xls")
   Set ws = Sheets("Results")
    
  ' Check if "Results" tab exists
    If ws Is Nothing Then
       MsgBox "Input file does not contain a [Results] tab.", vbCritical, "Import Data"
       Exit Function
    
    Else
       Set ws = Nothing

        'COPY INPUT FILE
        Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet)
       
        wbkInput.Worksheets("Results").Activate
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        ' PASTE
            Set wbkNew = Workbooks.Open(strCompletePathFilename)

           
        'wbkNew.Worksheets("OH Count").Activate
        'wbkNew.Worksheets("OH Count").Select
  
       'check if sheet exists
        myString = strDestSheet 'Change to the name you want
        On Error Resume Next
        Set checkSheet = Worksheets(myString)
        If Err.Number <> 0 Then
            Set checkSheet = Worksheets.Add
            checkSheet.Name = myString
        End If
        On Error GoTo 0
 
 '       wbkNew.Worksheets(strDestSheet).Select
 '       Range(strPasteRange).Select
 
  
          Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
              xlNone, SkipBlanks:=False, Transpose:=False
                
        ' For Cust Acct tabs, delete unwanted columns
        If strDelRng <> "" Then
            Columns("M:AX").Select
            Selection.Delete Shift:=xlToLeft
            strDelRng = ""
        End If
        
        Application.CutCopyMode = False
  

' Housekeeping
 
    Application.DisplayAlerts = False
        wbkInput.Close SaveChanges:=False
        wbkNew.SaveAs Filename:=strCompletePathFilename
        wbkNew.Close
        Set wbkInput = Nothing
        Set ws = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    
    End If

End Function

Select allOpen in new window

Book1.xls

Since this will take more time that I have for a few days, I've sent out a message to a few other experts who may be able to assist.  If no responses by the end of the week (or if I have some time) then I'll continue working with this to get it fixed for you.
--
RobS

Try this update, I have added a destination workbook variable in your function and tweaked a little the way you copy / paste the data.

Thomas

Private Sub CreateRCTExcelReportFile()
    
    Dim strReportFileName  As String 'E10 - New Report filename
    Dim strCompleteReportFileName As String  ' With date-time stamp
    Dim strInputFolder As String     'E6 - Input File Path
    Dim strNewFolder As String       'E12 save-to path for report
    Dim strCompletePathFilename As String    'Final path and filename with date-time stamps
    Dim strfilter As String
    Dim strDestSheet As String
    Dim i As Variant
    Dim arrayOfFiles() As Variant
    Dim strInputSheet As String
    Dim WB1 As Workbook
    Dim wbkNew As Workbook
    Dim strInputFile As String
    Dim strCopyRange As String
    Dim strPasteRange As String
    Dim strNewWkbk As String
    Dim strDelRng As String
    
        Worksheets("Main").Activate
        Set WB1 = ActiveWorkbook
   
   ' Initialize variables
   
    strReportFileName = Worksheets("Main").Range("E8")
    strInputFolder = Worksheets("Main").Range("E6")
    strNewFolder = Worksheets("Main").Range("E10")
    strfilter = "*.xls"
    
   'check for filename
    strCompleteReportFileName = strReportFileName & " " & Format(Now, "yyyymmdd hhmmss") & ".xls"
        If IsNull(strReportFileName) Or (strReportFileName) = "" Then MsgBox "Enter a valid filename for output file.", vbCritical, "Error - Report Parameters"
        If Left(strNewFolder, 1) <> "\" Then strNewFolder = strNewFolder & "\"
    strCompletePathFilename = strNewFolder & strCompleteReportFileName
    
    
    
    'create an array of customer account numbers
    arrayOfFiles = Array("809-618824", "809-618838", "827-618877")

   'create an array of input files
    Dim strArrayCustNums() As Variant
    
    strArrayCustNums = Array("RC-T Report OH Count 20110331200006 .xls", "RC-T Report 809-618838 20110331200006 .xls", "RC-T Report 809-618824 20110331200006 .xls", "RC-T Report 827-618877  20110331200006 .xls")
   
    'Create new report
 
    Set wbkNew = Workbooks.Add
    Application.DisplayAlerts = False
    wbkNew.Worksheets.Add.Name = "OH Count"
    wbkNew.SaveAs Filename:=strCompletePathFilename
    
       i = 0
       Dim UB As Integer
       UB = UBound(arrayOfFiles, 1)
       Do While i <= UB
        strInputSheet = arrayOfFiles(i)
            
            'Select Case (Left(strInputSheet, 22))
            Select Case (strInputSheet)
                    Case ("RC-T Report OH Count 2")
                        strDestSheet = "OH Count Collateral"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                        strInputFolder, strInputSheet, strCompletePathFilename, wbkNew)
                    Case Else
                        ' Load the customer account files
                        strDestSheet = strInputSheet
                        strCopyRange = "A:L"
                        strPasteRange = "A1"
                        strDelRng = "M:AX"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet, strCompletePathFilename, wbkNew, strDelRng)
               End Select
          i = i + 1
       Loop
       
        arrayOfFiles(i - 1) = strDestSheet
        wbkNew.Close (True)
       
       'format report
'         Call formatReport(strCompletePathFilename, strNewFolder)
       'check for bad records in OH Count sheet
 '        Call testOHData(strNewFolder, strCompleteReportFileName)

'Housekeeping
    Set WB1 = Nothing
    Set wbkNew = Nothing
        Application.Cursor = xlDefault
End Sub


Public Function inputFileData(strDestSheet As String, strCopyRange As String, strPasteRange As String, _
                        strInputFolder As String, strInputSheet As String, _
                        strCompletePathFilename As String, wbkDest As Workbook, Optional strDelRng As String) As Boolean
    
    Dim wbkInput As Workbook
    Dim wbkNew As Workbook
    Dim ws As Worksheet
    Dim wsht As Worksheet
    Dim flag As Boolean
    Dim cell1, cell2, rng As Range
    Dim checkSheet As Worksheet
    Dim myString As String

   Application.ScreenUpdating = False
     
  ' COPY INPUT FILE
   Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet & ".xls")
   Set ws = Sheets("Results")
    
  ' Check if "Results" tab exists
    If ws Is Nothing Then
       MsgBox "Input file does not contain a [Results] tab.", vbCritical, "Import Data"
       Exit Function
    
    Else
       Set ws = Nothing

        'check if Destination sheet exists / create if needed
        myString = strDestSheet
        
        On Error Resume Next
        Set checkSheet = wbkDest.Sheets(myString)
        If Err.Number <> 0 Then
            Set checkSheet = wbkDest.Sheets.Add
            checkSheet.Name = myString
        End If
        On Error GoTo 0
        
        'COPY AND PASTE INPUT FILE
        Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet)
       
        wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy wbkDest.Sheets(myString)

        wbkDest.Sheets(myString).Cells.Value = wbkDest.Sheets(myString).Cells.Value

        ' For Cust Acct tabs, delete unwanted columns
        If strDelRng <> "" Then
            Columns("M:AX").Select
            Selection.Delete Shift:=xlToLeft
            strDelRng = ""
        End If
        
        Application.CutCopyMode = False
  
' Housekeeping
 
    Application.DisplayAlerts = False
    wbkInput.Close SaveChanges:=False
    Set wbkInput = Nothing
    Set ws = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    
    End If

End Function

Select allOpen in new window

@nutsch:  I pasted in your changes, but now I get "Automation Error" at line 136.

OK, try and replace line 136

 wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy wbkDest.Sheets(myString)

Select allOpen in new window

by

 wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy wbkDest.Sheets(myString).range("A1")

Select allOpen in new window

nutsch: I still get an Automation Error on that line. (???)

What if you split the line?

wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy 
wbkDest.Sheets(myString).range("A1").paste

Select allOpen in new window

Now line 2 above errors on: "Runtime error 438: Object doesn't support this property or method"

I checked and both wbkDest and myString are initialized.  I added these two lines above the paste to make sure the wbkDest was activated:
        wbkDest.Worksheets(myString).Activate
        wbkDest.Worksheets(myString).Range("A1").Activate
I saw that cell A1 on the wbkDest was activiated, but still I get the error "Object doesn't support this property or method".  I've attached a printscreen.
I still do not see what the problem could possibly be(???).
Printscreen-Error.doc

I'm not sure if you want to pursue this further since you closed the question.  Did you want us to follow up on it?  If so, can you attach your spreadsheet so we can see if we get the same error?

So sorry, I must not have posted my last comments.  I got it working by adding going back to one line for the copy/paste, as follows:

        wbkDest.Worksheets(myString).Activate
        wbkDest.Worksheets(myString).Range("A1").Activate
        wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy Destination:=wbkDest.Sheets(myString).Range("A1")

I still don't understand what was wrong with my code, but I'm glad to have it working.

Thank you very much for your help.

Lynn
 

Private Sub CreateRCTExcelReportFile()
    
    Dim strReportFileName  As String 'E10 - New Report filename
    Dim strCompleteReportFileName As String  ' With date-time stamp
    Dim strInputFolder As String     'E6 - Input File Path
    Dim strNewFolder As String       'E12 save-to path for report
    Dim strCompletePathFilename As String    'Final path and filename with date-time stamps
    Dim strfilter As String
    Dim strDestSheet As String
    Dim i As Variant
    Dim arrayOfFiles() As Variant
    Dim strInputSheet As String
    Dim WB1 As Workbook
    Dim wbkNew As Workbook
    Dim strInputFile As String
    Dim strCopyRange As String
    Dim strPasteRange As String
    Dim strNewWkbk As String
    Dim strDelRng As String
    
        Worksheets("Main").Activate
        Set WB1 = ActiveWorkbook
   
   ' Initialize variables
   
    strReportFileName = Worksheets("Main").Range("E8")
    strInputFolder = Worksheets("Main").Range("E6")
    strNewFolder = Worksheets("Main").Range("E10")
    strfilter = "*.xls"
    
   'check for filename
    strCompleteReportFileName = strReportFileName & " " & Format(Now, "yyyymmdd hhmmss") & ".xls"
        If IsNull(strReportFileName) Or (strReportFileName) = "" Then MsgBox "Enter a valid filename for output file.", vbCritical, "Error - Report Parameters"
        If Left(strNewFolder, 1) <> "\" Then strNewFolder = strNewFolder & "\"
    strCompletePathFilename = strNewFolder & strCompleteReportFileName
    
    


    'create an array of customer account numbers
    arrayOfFiles = Array("809-618824", "809-618838", "827-618877")

   'create an array of input files
    Dim strArrayCustNums() As Variant
    
    strArrayCustNums = Array("RC-T Report OH Count P.xls", "809-618824.xls", "809-618838.xls", "827-618877.xls")
   
    'Create new report
 
    Set wbkNew = Workbooks.Add
    Application.DisplayAlerts = False
    wbkNew.Worksheets.Add.Name = "OH Count"
    wbkNew.SaveAs Filename:=strCompletePathFilename
    
       i = 0
       Dim UB As Integer
       UB = UBound(arrayOfFiles, 1)
       Do While i <= UB
        strInputSheet = arrayOfFiles(i)
            
            'Select Case (Left(strInputSheet, 22))
            Select Case (strInputSheet)
                    Case ("RC-T Report OH Count P.xls")
                        strDestSheet = "OH Count Pool"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                        strInputFolder, strInputSheet, strCompletePathFilename, wbkNew)
                    Case Else
                        ' Load the customer account files
                        strDestSheet = strInputSheet
                        strCopyRange = "A:L"
                        strPasteRange = "A1"
                        strDelRng = "M:AX"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet, strCompletePathFilename, wbkNew, strDelRng)
               End Select
          i = i + 1
       Loop
       
        arrayOfFiles(i - 1) = strDestSheet
        wbkNew.Close (True)
       
       'format report
'         Call formatReport(strCompletePathFilename, strNewFolder)
       'check for bad records in OH Count sheet
 '        Call testOHData(strNewFolder, strCompleteReportFileName)

'Housekeeping
    Set WB1 = Nothing
    Set wbkNew = Nothing
        Application.Cursor = xlDefault
End Sub


Public Function inputFileData(strDestSheet As String, strCopyRange As String, strPasteRange As String, _
                        strInputFolder As String, strInputSheet As String, _
                        strCompletePathFilename As String, wbkDest As Workbook, Optional strDelRng As String) As Boolean
    
    Dim wbkInput As Workbook
    Dim wbkNew As Workbook
    Dim ws As Worksheet
    Dim wsht As Worksheet
    Dim flag As Boolean
    Dim cell1, cell2, rng As Range
    Dim checkSheet As Worksheet
    Dim myString As String

   Application.ScreenUpdating = False
     
  ' COPY INPUT FILE
   Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet & ".xls")
   Set ws = Sheets("Results")
    
  ' Check if "Results" tab exists
    If ws Is Nothing Then
       MsgBox "Input file does not contain a [Results] tab.", vbCritical, "Import Data"
       Exit Function
    
    Else
       Set ws = Nothing

        'check if Destination sheet exists / create if needed
        myString = strDestSheet
        
        On Error Resume Next
        Set checkSheet = wbkDest.Sheets(myString)
        If Err.Number <> 0 Then
            Set checkSheet = wbkDest.Sheets.Add
            checkSheet.Name = myString
        End If
        On Error GoTo 0
        
        'COPY AND PASTE INPUT FILE
        Set wbkInput = Workbooks.Open(strInputFolder & "\" & strInputSheet)
       
'        wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy
        wbkDest.Worksheets(myString).Activate
        wbkDest.Worksheets(myString).Range("A1").Activate
        wbkInput.Worksheets("Results").Range("A1").CurrentRegion.Copy Destination:=wbkDest.Sheets(myString).Range("A1")
 
        ' For Cust Acct tabs, delete unwanted columns
        If strDelRng <> "" Then
            Columns("M:AX").Select
            Selection.Delete Shift:=xlToLeft
            strDelRng = ""
        End If
        
        Application.CutCopyMode = False
  
' Housekeeping
 
    Application.DisplayAlerts = False
    wbkInput.Close SaveChanges:=False
    Set wbkInput = Nothing
    Set ws = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    
    End If

End Function

Select allOpen in new window