Open/close files and copy and paste problem

**kb9nvh** · 01-10-2011, 02:12 PM

Newbie here. Below is my code. Attempting to parse through all the tabs in the active worksheet and the ones starting with "x's" I want to pull the data from columns D and E and put into a new .csv file. I have been sucessful but only if the csv files already exists. If I create the file then I am unable to paste into it. I've even attempted to create it, and then close it just to reopen it to no avail. Honestly, VBA with excel is the most agravating coding I have ever experienced. Thanks for any help. Todd
The error it throws is "PasteSpecial Method of Range class failed"

Sub MoveDataToCSVfiles_notworkiking()
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim pname As String
    Dim WB As String
    Dim wsname As String
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
On Error GoTo 0

WB = ActiveWorkbook.Name
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .AllowMultiSelect = False
    .Title = "Select directory to Export csv's :"
    If .Show = True Then
        pname = CurDir
        WB = ActiveWorkbook.Name
    End If
End With

sheetcount = ActiveWorkbook.Worksheets.count

For Each Worksheet In Workbooks(WB).Worksheets
wsname = Worksheet.Name
sheetnum = Worksheet.index

    If (Mid(wsname, 1, 1) = "x") Then  'If worksheet begins with the letter x then...
        Set sourceSheet = ActiveWorkbook.Worksheets(wsname)
        sourceSheet.Activate
        Workbooks(WB).Worksheets(sheetnum).Range(Range("D3"), Range("E3").End(xlDown)).Select
        Selection.Copy
        
        'Adding these next two lines makes this script crash at the "paste" a few lines down.
        'Moving these two lines before the copy function eliminates the issue as creating the new file wipes out the "copied" information
        '*******************************************************
        Workbooks.Add.SaveAs (pname & "\" & wsname & ".csv"), FileFormat:=xlCSVWindows
        ActiveWorkbook.Close       
        '*******************************************************
        
        Workbooks.Open Filename:=(pname & "\" & wsname & ".csv")
        ActiveWorkbook.Worksheets.Select
        Set destSheet = Worksheets("sheet1")
        destSheet.Activate
        destSheet.Cells.Select
        
        '*****CRASH at next line if file was created during execution as opposed to just opened from existing.
        Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, Skipblanks:=False, Transpose:=False
        '**********************
        ActiveWorkbook.Close (savechanges)
    End If
Next Worksheet
End Sub

**foxguy** · 01-10-2011, 04:57 PM

Hi Todd;

At first glance I don't see a problem. What is the error message that you get when it crashes?

**kb9nvh** · 01-10-2011, 06:31 PM

Thanks for the response...
I'm using excel 2007 just so you know.
I'll run it tomorrow when I'm back at work and post the error message. I forget exactly what the complaint is. If you care to recreate the issue, just make a workbook with a few worksheets, name one with an "x" as the first character. add some data to columns D and E. This code is suppose to parse through each tab and when it finds a tab with a "x" then it copies the data that exists in columns D and E. Then the code should create a .csv file name derived from the tab name and insert the column data into the first two columns. This code all works fined if the .csv file already exists (and I eliminate the two lines that create the file). When I create the file on the fly and then close it. Then Reopen it it runs up until the Paste command where it bombs with an error (I cant remember which one but its something about a method not supported I think.

For the life of me, I think I should just be able to move those columns right from one workbook to another without all the copy and pasting but I'm too stupid to understand the excel VBA grand plan and it seems like nothing works twice in the way you want it to. '

I'll post again tomorrow if the snow allows me to get into work.

Originally Posted by foxguy

Hi Todd;

At first glance I don't see a problem. What is the error message that you get when it crashes?

**kb9nvh** · 01-11-2011, 09:31 AM

SOLVED: Moved the "copy" portion after the file create as the create new file wipes out the data in the paste buffer.

The error it throws is "PasteSpecial Method of Range class failed" . If the file already exsists and I just open it then the paste functions as expected.

I did modify this .add.saveas to include the .csv fileformat as I found that it was just saving it as the default type but with a false extension.

OK, someone here suggested that creating the new file would wipe out all of my "copy" data. That was the problem is there was not data to paste.

Can someone suggest code that will eliminate the copy/paste step and just allow me to directly assign the data from one workbook to another? I've tried it but always with errors that I'm at a loss to understand.

Thanks for the hand holding..

**kb9nvh** · 01-12-2011, 02:30 PM

Here's the working version for anyone who cares..haha

Sub MoveDataToCSVfiles()
    Dim SourceSheet As Worksheet
    Dim DestSheet As Worksheet
    Dim pname As String
    Dim WB As String
    Dim wsname As String
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
    Dim SourceRange As Range
    Dim rowcount As Double
On Error GoTo 0
Application.ScreenUpdating = False 'Turn off screenupdating for faster operation
WB = ActiveWorkbook.Name
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .AllowMultiSelect = False
    .Title = "SELECT YOUR OUTPUT DIRECTORY FOR THE .CSV FILES"
    If .Show = True Then
        pname = CurDir
        WB = ActiveWorkbook.Name
    End If
End With

sheetcount = ActiveWorkbook.Worksheets.Count

For Each Worksheet In Workbooks(WB).Worksheets
wsname = Worksheet.Name
sheetnum = Worksheet.Index

    If (Mid(wsname, 1, 1) = "x") Then  'If worksheet begins with the letter x then...
        OutName = Mid(wsname, 3, 128)
        Set SourceSheet = ActiveWorkbook.Worksheets(wsname)
        
'********************************************
        Rem Workbooks.Add.SaveAs (pname & "\" & wsname & ".xlsx"), FileFormat:=51     '51 is .xls'
        Workbooks.Add.SaveAs (pname & "\" & OutName & ".csv"), FileFormat:=xlCSV
'**********************************************
        
        '****Reset just created file to get out of compatibility mode to allow more than 65K rows
        ActiveWorkbook.Close (savechanges = False)
        
'*********************************************
        Rem Workbooks.Open Filename:=(pname & "\" & wsname & ".xlsx")
        Workbooks.Open Filename:=(pname & "\" & OutName & ".csv")   'Swap back to the first line for xlsx instead
'**********************************************
        
'***********************************************
        Rem Set DestSheet = Worksheets("sheet1")   'default worksheet name is "sheet1" for an XLSX file but is
        Set DestSheet = Worksheets(OutName) 'Default worksheet name is the name of the file for a .csv file
'***********************************************

        'Activate the source workbook and copy the correct rows/columns all the way to the end of the data
        SourceSheet.Activate
        Workbooks(WB).Worksheets(sheetnum).Range(Range("D4"), Range("E4").End(xlDown)).Select
        Selection.Copy
        'After a copy never do any file manipulations or even tab changes since your copy data will dissapear and you will be unable to Paste
        
              
        'Use the defined source range and then find its number of rows.  You need this for the paste because excel
        'will be very picky about not pasteing unless the paste range is exactly the same as the copy range
        Set SourceRange = ActiveSheet.Range(Range("D4"), Range("E4").End(xlDown))
        rowcount = SourceRange.Rows.Count

        
        DestSheet.Activate
        DestSheet.Range("a1", Cells(rowcount, 2).Address(False, False)).Select
        
        '*****CRASH at next line if file you did much of anything in the program after the "copy" step above
        Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, Skipblanks:=False, Transpose:=False
        '**********************
        
        'Save the file as a CSV instead of and .XLSX
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs (pname & "\" & OutName & ".csv"), FileFormat:=xlCSV
        ActiveWorkbook.Close (savechanges = True)
        Application.DisplayAlerts = True
    End If
Next Worksheet
Application.ScreenUpdating = True 'Turn off screenupdating for faster operation
MsgBox ("Your Files are located at->" & pname & "   Really, go look!!")
End Sub