• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 385
  • Last Modified:

Copying data from Excel 2007Worksheet to Excel 2003 worksheet

I am trying to copy data from a 2007 spreadsheet to a 2003 spreadsheet using VBA. The code will sporatically open the 2003 workbook in compatability mode and the code goes throught the process of copying the data but no data can be found on the 2003 worksheet under the user name sheet.
Trying to copy from columns 1-9 and rows 16 down as long as there is data there

I have received warnings that the connection was blocked but after I allow the connection it still does not work

can you help?
Sub NewStart()
Dim n As Long, lngcol As Long
Dim WshSource As Worksheet
Dim WshTarget As Worksheet
Dim WshTgtX As Worksheet
Dim WshTgtY As Worksheet
Dim FullFile As Variant
Dim work_book As Workbook
Dim WshSrce As Workbook
Dim last_sheet As Worksheet
Dim iFileFormat As Integer
Dim WS As Worksheet
Application.ScreenUpdating = False
Dim Msg, Style, Title, Response, MyString
Msg = "Click No to Finalize Notes"
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
Title = "Click No to Complete Notes"    ' Define title.

Response = MsgBox(Msg, Style, Title)


 If Response = vbNo Then    ' User chose No.
    MyString = "No"    ' Perform some action.
    Exit Sub
Else    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.


     

rng = Environ("UserName")
If Not Worksheets(1).Name = "UNNAMED" Then
  rng = Environ("UserName")
  Worksheets(1).Name = rng
Else
  rng = Worksheets(1).Name 'Now rng equals the right name always
End If

On Error Resume Next
Set work_book = Workbooks.Open(Sheets(2).Range("J4").Value)
  work_book.Sheets(rng).Name 'error 9 if sheet does not exist
If Err.Number = 9 Then   'create the sheet
  Set last_sheet = work_book.Sheets(work_book.Sheets.Count)
  Set WshTarget = work_book.Sheets.Add(After:=last_sheet)
  WshTarget.Name = rng
Else                     'use existing sheet
  Set WshTarget = work_book.Sheets(rng)
End If

Set WshSource = Worksheets(1)


With WshSource
For lngcol = 1 To 9
If n < 16 Then n = 16
n = WshSource.Cells(WshSource.Rows.Count, lngcol).End(xlUp).Row
WshSource.Range(.Cells(16, lngcol), .Cells(n, lngcol)).Copy
WshTarget.Cells(3, lngcol).PasteSpecial xlValues
Application.CutCopyMode = False
Next lngcol

End With
End If
WshTarget.Activate
 iFileFormat = IIf(Application.Version < 12, xlWorkbookNormal, 56)   '.xls file format for Excel 2003


ActiveWorkbook.Save
ActiveWorkbook.Close
WshSource.Activate
 iFileFormat = IIf(Application.Version = 12, xlWorkbookNormal, 52)   '.xlsm file format for Excel 2003
ThisWorkbook.Save
ThisWorkbook.Close
Application.ScreenUpdating = True
End Sub

Open in new window

CallSummary1.xls
Calltracker.xlsm
0
llawrenceg
Asked:
llawrenceg
  • 5
  • 4
  • 2
2 Solutions
 
rspahitzCommented:
Have you simply tried recording a macro that does "Save As..." "2003 format"?
0
 
llawrencegAuthor Commented:
 the suggestion is a good one but does not solve the problem of the data not being copied from the 2007 spreadsheet to the 2003 spreadsheet.
This is the section of the code that does not work. It steps through great but when you look at the sheet the data is not there

With WshSource
For lngcol = 1 To 9
If n < 16 Then n = 16
n = WshSource.Cells(WshSource.Rows.Count, lngcol).End(xlUp).Row
WshSource.Range(.Cells(16, lngcol), .Cells(n, lngcol)).Copy
WshTarget.Cells(3, lngcol).PasteSpecial xlValues
Application.CutCopyMode = False
Next lngcol

End With
End If

Open in new window

0
 
rspahitzCommented:
Have you tried stepping through to see what the value of "n" is after it's assigned?

Also, one of the worst things you can do in VB is this:

On Error Resume Next

When an error occurs, it will simply be ignored so you never know it happened.
A much better approach is error management:

Sub...
On Error Goto Err_Handler
...
Normal_Exit:
   Exit Sub
Err_Handler:
   MsgBox Err.Description
   Resume Normal_Exit
End Sub

From my test (from your attached workbook, which doesn't really have much data), I get an unannounced error here:


Else                     'use existing sheet
  Set WshTarget = work_book.Sheets(rng)
End If

because rng has a name that doesn't match any on your sheets.  You may be experiencing the same thing but you'll never know without error management.

\What happens for me is that WshTarget is never set because the sheet doesn't exist so it ignores the error and moves on.
Later, when it goes to paste, the variable was never assigned a sheet object so it fails but never tells me, etc, etc.

--
Is the attached workbook (calltracker) the one that has data in it to test?
0
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 
llawrencegAuthor Commented:
Here is the code piece that names the tab in the summary workbook.
rng = Environ("UserName")
If Not Worksheets(1).Name = "UNNAMED" Then
  rng = Environ("UserName")
  Worksheets(1).Name = rng
Else
  rng = Worksheets(1).Name 'Now rng equals the right name always
End If

rng beomes the User ID from the Environ(UserName) and then is used for the tab name in the CallSummary sheet. This way there is a tab for each user in the Summary sheet


Here is the code that pulls in the CallSummary sheet. It is referenced in cell J4 of Sheet 2

Set work_book = Workbooks.Open(Sheets(2).Range("J4").Value)



The CallTracker is the one with the data to test
0
 
rspahitzCommented:
Replace your procedure with the one below (which does the same but shows errors)
Let me know if you get any error messages, and what they are (you may get several.)
Sub NewStart()
    On Error GoTo NewStart_Err
    
    Dim rng As String
    Dim n As Long, lngcol As Long
    Dim WshSource As Worksheet
    Dim WshTarget As Worksheet
    Dim WshTgtX As Worksheet
    Dim WshTgtY As Worksheet
    Dim FullFile As Variant
    Dim work_book As Workbook
    Dim WshSrce As Workbook
    Dim last_sheet As Worksheet
    Dim iFileFormat As Integer
    Dim WS As Worksheet
    Dim Msg, Style, Title, Response, MyString
    
    Application.ScreenUpdating = False
    Msg = "Click No to Finalize Notes"
    Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
    Title = "Click No to Complete Notes"    ' Define title.
    
    Response = MsgBox(Msg, Style, Title)
    
    If Response = vbNo Then    ' User chose No.
        MyString = "No"    ' Perform some action.
        Exit Sub
    Else    ' User chose Yes.
        MyString = "Yes"    ' Perform some action.
        
        rng = Environ("UserName")
        If Not Worksheets(1).Name = "UNNAMED" Then
            rng = Environ("UserName")
            Worksheets(1).Name = rng
        Else
            rng = Worksheets(1).Name 'Now rng equals the right name always
        End If
        
        'On Error Resume Next
        Set work_book = Workbooks.Open(Sheets(2).Range("J4").Value)
        work_book.Sheets(rng).Name 'error 9 if sheet does not exist
        If Err.Number = 9 Then   'create the sheet
            Set last_sheet = work_book.Sheets(work_book.Sheets.Count)
            Set WshTarget = work_book.Sheets.Add(After:=last_sheet)
            WshTarget.Name = rng
        Else                     'use existing sheet
            Set WshTarget = work_book.Sheets(rng)
        End If
        
        Set WshSource = Worksheets(1)
        
        With WshSource
            For lngcol = 1 To 9
                If n < 16 Then n = 16 ' THIS LINE IS USELESS!
                n = WshSource.Cells(WshSource.Rows.Count, lngcol).End(xlUp).Row
                WshSource.Range(.Cells(16, lngcol), .Cells(n, lngcol)).Copy
                WshTarget.Cells(3, lngcol).PasteSpecial xlValues
                Application.CutCopyMode = False
            Next lngcol
        End With
    End If
    WshTarget.Activate
    iFileFormat = IIf(Application.Version < 12, xlWorkbookNormal, 56)   '.xls file format for Excel 2003
    
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    WshSource.Activate
    iFileFormat = IIf(Application.Version = 12, xlWorkbookNormal, 52)   '.xlsm file format for Excel 2003
    ThisWorkbook.Save
    ThisWorkbook.Close
    
NewStart_Exit:
    Application.ScreenUpdating = True
    Exit Sub
    
NewStart_Err:
    MsgBox Err.Number & " - " & Err.Description
    Resume Next
    'Resume NewStart_Exit
End Sub

Open in new window

0
 
broro183Commented:
On a similar train of thought to rsphitz...
Do you know that the "iFileFormat" variable is defined in an IIF statement, but is not subsequently used?

After glancing through your code, I can't see an obvious cause, but I have another suggestion & a question:

-
'I suggest a change in the below sub
Sub DataCopy()    '
'other dims...
'change the next line from...
Dim foundRows(2) As Integer, i As Integer
'to
Dim foundRows(2) As Long, i As Long
'this will ensure that if the rows are > ~32k the code will continue to work instead of having an "overflow error" due to the size limitations of the Integer data Type.

Open in new window


- Do you ever clear the clipboard?


hth
Rob
0
 
llawrencegAuthor Commented:
Rob
Good suggestion and yes the clipboard is cleared
Sub CheckClipboard()
Dim DataObject As String
Dim MyData As DataObject
Dim AllStr As String
Dim ShortStr As String
Dim TimeC As Range
Application.ScreenUpdating = False
Set MyData = New DataObject

On Error Resume Next

MyData.GetFromClipboard
If MyData.GetFormat(1) = True Then
AllStr = MyData.GetText(1)
End If
ShortStr = Left(AllStr, 4)
dt = Now + TimeValue("00:00:07")
If (ShortStr = "PLAN") Then
   Worksheets(1).Activate
   ThisWorkbook.Sheets(1).Cells(15, 2).Paste
   Range("B15").Value = Left(Trim(Range("B15").Value), 12)
   Set TimeC = ThisWorkbook.Sheets(1).Range("C15")
   TimeC = TimeC.Value
   MyData.SetText ""
   MyData.PutInClipboard
   TimeC.Value = Date & ":" & Time
End If
Set MyData = Nothing
  If Range("A1").Value <> 1 Then
Application.OnTime dt, "CheckClipboard"
Application.ScreenUpdating = True
End If
End Sub

Open in new window

0
 
llawrencegAuthor Commented:
I f found my problem

Set WshSource = Worksheets(1)
should be
Set WshSource = Thisworkbook.Worksheets(1)

I was copying the blank columns to themselves so I could see where the code had been but no data as the code was copying the data from the summary sheet to itself
0
 
llawrencegAuthor Commented:
Thanks for pointing me  in the right direction. I have spent days on this project of working with 2007 and 2003 siimultaneously. You gus  have save me tons of tme.
Thank you again
0
 
rspahitzCommented:
you're welcome.  Sometimes it's tough to know how to approach a problem to get a solution.  I'm glad you're finally on your way forward.
0
 
broro183Commented:
I'm pleased we could help - thanks for the points :-)

To help minimise the chance of errors with other ranges I suggest creating a worksheet/range variable for things that are referred to more than once*, Setting the variable to the relevant worksheet/range, then using the variable throughout the rest of the code & finally Setting the variable to nothing at the end of your code.

* For example "ThisWorkbook.Sheets(1)" is referenced a few times in post # 35737194.

------

I think that "Set WshSource = Thisworkbook.Worksheets(1)" is a well defined variable because it is explicitly defined to the Workbook level. You are probably aware of this but it may help others who come across this thread...
When some object variables are not explicitly defined to the workbook level there is usually (always?) a default "parent (object qualifier) assigned by vba. For example, the Excel 2007 Help files state:
"Application.ActiveSheet Property: If you don’t specify an object qualifier, this property returns the active sheet in the active workbook."

Here are some other examples that I can think of (in the form of Object - default "parent object"):
Activesheet - activeworkbook
Worksheets("xyz") - activeworkbook
Range("a1") - Activesheet
Cells(1,2) - Activesheet

hth
Rob
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 5
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now