Results 1 to 9 of 9
  1. #1
    3 Star Lounger
    Join Date
    Mar 2004
    Location
    North Carolina, USA
    Posts
    268
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Pull data from several worksheets onto one (2002)

    Hi Loungers, I have financial data for 16 departments on 16 different worksheets. The data is unique; however, all columnar data is of the same type. For example,
    Vendor Amount GL Code Voucher Number

    Is there a way to put all of the data onto one worksheet automatically without copying and pasting?

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Pull data from several worksheets onto one (2002)

    Can you give us a workbook that shows what you have with a sheet that shows what you want? The data in the worksheets can be dummy data.
    Legare Coleman

  3. #3
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Pull data from several worksheets onto one (2002)

    Mitch

    I did a similar exercise a year or go. I used this code:

    <div style="width: 100%; background-color: #FFFFFF;">

    Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Public Declare Function GetLastError Lib "kernel32" () As Long
    Public Const OFS_MAXPATHNAME = 128
    Public Const OF_READ = &H0
    Public Const OF_SHARE_EXCLUSIVE = &H10
    Dim Definer As Long
    Dim strPath As String
    Dim strfile As String
    Dim FolderLoc As String
    Public Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
    End Type

    Sub Combine()

    Dim wbkSource As Workbook
    Dim wbkTarget As Workbook
    Dim strname As String
    Dim strFull As String
    On Error Resume Next

    ' Selects Folder location
    strPath = FolderLoc & "myFolder" 'This can change when new folder is created
    If strPath = "" Then
    Exit Sub
    End If

    ' Sets Current workbook as Target

    Set wbkTarget = ThisWorkbook

    strfile = Dir(strPath & "*.xls")
    strFull = strPath & "" & strfile

    Do While Not (strfile = "")
    isFileOpen (strFull)
    If Definer = 32 Then

    MsgBox "File" & strfile & " " & "is currently open on the system folder" & vbCrLf & "This program cannot continue until it is closed"
    Set wbkSource = Nothing
    Set wbkTarget = Nothing

    GoTo ExitHandler
    Else

    End If

    Set wbkSource = Workbooks.Open(Filename:=strPath & "" & strfile, AddToMRU:=False)


    wbkSource.Worksheets.Copy after:=wbkTarget.Worksheets(wbkTarget.Worksheets.C ount)

    strname = Left(strfile, Len(strfile) - 4)
    ActiveWorkbook.ActiveSheet.Name = (strname)
    wbkSource.Close SaveChanges:=False
    strfile = Dir

    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells(1, 1).Select
    Loop


    ExitHandler:
    Set wbkSource = Nothing
    Set wbkTarget = Nothing
    Exit Sub
    End Sub</div hiblock>
    All files were in a network share and were pulled from that location to my main workbook. I also used this code to check if any of the workbooks were open in case they were being worked on.

    <div style="width: 100%; background-color: #FFFFFF;">Public Function isFileOpen(pFileName As String) As Long
    Dim hFile As Long
    Dim OfStructure As OFSTRUCT
    Dim x As Long

    OfStructure.cBytes = 136

    hFile = OpenFile(pFileName, OfStructure, OF_READ + OF_SHARE_EXCLUSIVE)

    isFileOpen = OfStructure.nErrCode
    Definer = isFileOpen


    x = CloseHandle(hFile)

    If x = 0 Then
    isFileOpen = GetLastError()
    Exit Function
    End If

    End Function</div hiblock>

    You may have to clear some of the DIM's at the top as I did a part cut and paste...but hopes this helps and gets you started
    Jerry

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Pull data from several worksheets onto one (2002)

    If this is a one time operation, copy and paste is probably the fastest method. If you have to do it repeatedly, you could write a macro to loop through the worksheets and perform the copy/paste.

  5. #5
    3 Star Lounger
    Join Date
    Mar 2004
    Location
    North Carolina, USA
    Posts
    268
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Pull data from several worksheets onto one (2002)

    Here you go. Each worksheet is like this.

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Pull data from several worksheets onto one (2002)

    Here is a macro, to be run while the workbook with the 16 worksheets is active. I have assumed that there are no other worksheets.

    Sub MakeNew()
    Dim wbkCur As Workbook
    Dim wbkNew As Workbook
    Dim wshCur As Worksheet
    Dim wshNew As Worksheet
    Dim lngRow As Long

    Set wbkCur = ActiveWorkbook
    Set wbkNew = Workbooks.Add(xlWBATWorksheet)
    Set wshNew = wbkNew.Worksheets(1)

    ' Copy first row
    wbkCur.Worksheets(1).Rows(1).Copy Destination:=wshNew.Rows(1)

    For Each wshCur In wbkCur.Worksheets
    lngRow = wshNew.Range("A65536").End(xlUp).Row + 1
    wshCur.Range(wshCur.Range("A2"), wshCur.Range("K65536").End(xlUp)).Copy _
    Destination:=wshNew.Range("A" & lngRow)
    Next wshCur
    End Sub

    The data will be copied to a new workbook with only one worksheet.

  7. #7
    3 Star Lounger
    Join Date
    Mar 2004
    Location
    North Carolina, USA
    Posts
    268
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Pull data from several worksheets onto one (2002)

    Works like a champ - THANKS. As you often hear, you are the man!

  8. #8
    3 Star Lounger
    Join Date
    Mar 2004
    Location
    North Carolina, USA
    Posts
    268
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Pull data from several worksheets onto one (2002)

    One more thing. What is the best way to save macros so they are universally usable on all projects - and not workbook specific?

  9. #9
    Platinum Lounger
    Join Date
    Nov 2001
    Location
    Vienna, Wien, Austria
    Posts
    5,009
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Pull data from several worksheets onto one (20

    Put the code into personal.xls - as explained in <!post=this Star Post,118382>this Star Post<!/post>. HTH
    Gre

Posting Permissions

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