Consulting

Results 1 to 2 of 2

Thread: Copying Data from different workbooks

  1. #1
    VBAX Regular
    Joined
    Sep 2008
    Posts
    8
    Location

    Copying Data from different workbooks

    Hi There,

    hope someone can help. Basically most of my macros are given to a user who then clicks a button to execute it. The button executes a macro by giving the user the standard MS Excel browse box. User then picks correct workbook he/she wants processed. Macro then opens that workbook copies the relevant sheet's data and then pastes into a new sheet on the macro.xls file. This then allows vlookups etc to give the user the correct data on a summary sheet without changing the original data sheet. The problem is the syntax I normally use seems to only work only erratically now.

    e.g.

    [vba]Dim aaaa_bbbb As Variant

    aaaa_bbbb = Application.GetOpenFilename("Latest ----(-- New Spreadsheet) (*.xls), *.xls", , _
    "Select Current -- Report", , False)
    If aaaa_bbbb = False Then
    MsgBox "Require Current ----- to continue - process exiting."
    Exit Sub
    End If

    Workbooks.Open aaaa_bbbb
    n = 1
    Do Until Left(Sheets(n).Name, 4) = "cccc"
    n = n + 1
    Loop
    Sheets(n).Select

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    'need to remove filters aaaa_bbbb

    If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    End If
    'Reselect all data to copy and paste it aaaa_bbbb
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("------- Macro.xls").Activate
    Sheets("dddd").Select
    Range("A1").Select
    ' Windows("------ Macro.xls").Sheets("dddd").Cells("A1").Paste
    ActiveSheet.Paste
    [/vba] Could somebody advise where I am going wrong. Is it possibly aaaa_bbbb is a variant and I am treating it like an object? If there is a better or standard way of doing this could somebody let me have a copy? I've simplified what I've pasted and also changed names because of company data policy also normally I am selecting and using more than one spreadsheet (workbook) as the data to be processed

    Bruce T
    Last edited by Aussiebear; 10-13-2009 at 03:09 PM. Reason: Added VBA tags to code, & amended to suit page

  2. #2
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    Hi there, welcome to the board Bruce!

    There are a few things I would change. I did most of my commenting in the code, so take a peek, see if it helps...
    [vba]Option Explicit

    Sub Testingxxxxxxxxxx()

    Dim aaaa_bbbb As Variant
    Dim wb As Workbook, ws As Worksheet
    Dim wbDest As Workbook, wsDest As Worksheet
    Dim n As Long, sWbName As String

    'Get workbook from user choice
    aaaa_bbbb = Application.GetOpenFilename("Latest ----(-- New Spreadsheet) (*.xls), *.xls", , _
    "Select Current -- Report", , False)

    'Check if user chose a file, cancel if not
    If TypeName(aaaa_bbbb) = "Boolean" Then
    MsgBox "Require Current ----- to continue - process exiting."
    Exit Sub
    End If

    'Get workbook name only
    sWbName = Right(aaaa_bbbb, Len(aaaa_bbbb) - InStrRev(aaaa_bbbb, Application.PathSeparator))

    'Check if workbook is open, set as variable and open
    If ISWBOPEN(sWbName) = True Then
    Set wb = Workbooks(sWbName)
    Else
    Set wb = Workbooks.Open(aaaa_bbbb)
    End If

    '###########################################################
    'What if that sheet name isn't found?
    ''' n = 1
    ''' Do Until Left(Sheets(n).Name, 4) = "cccc"
    ''' n = n + 1
    ''' Loop
    ''' Sheets(n).Select
    '-----------------------------------------------------------
    'Here is another alternative, utilizing the function below
    If WSEXISTS("cccc", wb) = True Then
    'do what you want here, cause the worksheet exists
    'I'm going to assume you want to work with it so
    ' I'll set it as a variable (recommended) and use it
    Set ws = wb.Worksheets("cccc")
    Else
    'worksheet does not exist, what shall you do here?
    End If
    '###########################################################

    'Set destination workbook/worksheet
    'Don't know if this workbook would always be open or not
    'If it may not be, I would run a check on it like the other
    ' workbook. Same with the worksheet
    Set wbDest = Workbooks("------- Macro.xls")
    Set wsDest = wbDest.Worksheets("dddd")

    '###########################################################
    'Don't need to select anything, so I'll commend out your
    ' code and give an example of what I'd do
    ''' Range("A1").Select
    ''' Range(Selection, Selection.End(xlToRight)).Select
    ''' Range(Selection, Selection.End(xlDown)).Select
    '''
    ''' 'need to remove filters aaaa_bbbb
    '''
    ''' If ActiveSheet.FilterMode Then
    ''' ActiveSheet.ShowAllData
    ''' End If
    ''' 'Reselect all data to copy and paste it aaaa_bbbb
    ''' Range("A1").Select
    ''' Range(Selection, Selection.End(xlToRight)).Select
    ''' Range(Selection, Selection.End(xlDown)).Select
    ''' Selection.Copy
    ''' Windows("------- Macro.xls").Activate
    ''' Sheets("dddd").Select
    ''' Range("A1").Select
    ''' ' Windows("------ Macro.xls").Sheets("dddd").Cells("A1").Paste
    ''' ActiveSheet.Paste
    '-----------------------------------------------------------
    ws.AutoFilterMode = False
    With ws.Range(ws.Range("A1"), ws.Range("A1").End(xlToRight).End(xlDown))
    .Copy wsDest.Range("A1")
    End With
    '###########################################################

    End Sub

    Public Function WSEXISTS(wsName As String, Optional wkb As Workbook) As Boolean
    If wkb Is Nothing Then
    If ActiveWorkbook Is Nothing Then Exit Function
    Set wkb = ActiveWorkbook
    End If
    On Error Resume Next
    WSEXISTS = CBool(Len(wkb.Worksheets(wsName).Name))
    End Function

    Public Function ISWBOPEN(wbName As String) As Boolean
    'Originally found written by Jake Marx
    On Error Resume Next
    ISWBOPEN = Len(Workbooks(wbName).Name)
    End Function[/vba]

    HTH

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •