My collection of things.

jKafer on the Net

May 8th, 2015 at 2:11 pm

Collect Area from multiple tabs in Excel Workbook

Every once in awhile I need to refresh my “geekiness” and do some programming.  This week I had a project to take an excel file with 200 tabs (each employee had a tab with their information on it) and combine it into 1 worksheet so that it could be imported into a database without retyping all the information.

So I “googled” to see if I could find something that would do it, I found a couple of close ones, many way off ones so I took the best of them all and made this one.

  1. In preparing to run this macro I went into the first employee’s sheet and made sure that all the information was in A1.I1  – I used the “=F45” to get the information from other places on the sheet to where I wanted it.
  2. I then copied that formula to all the tabs – tedious, but very effective.  So I know had all the information I wanted to pull over into my one worksheet in the same layout and place on each tab.
  3. Then comes the macro:
    1. Creates another tab named “Combined” – which is also Sheet1
    2. Go to each tab in the workbook (Sheets.Count)
    3. Highlights the area that I have the formulas collection the information on each tab (A1.I1)
    4. Copies it (Selection.Copy)
    5. Make Combined Sheet the active sheet (Sheets(1).Activate)
    6. Go to the bottom of Column A in the worksheet – skip up to the last row of data in column A (the best way to explain this is if you were in the worksheet in column A, GoTo (ctrl-G) A65536 (way down the column) press the End key and then the Up key and it will bring you to the bottom of the data you collected). Then paste the values of what you copied in #D above.
      Range(“A65536”).End(xlUp)(2).PasteSpecial xlPasteValues
Sub CollectIt()
 Dim J As Integer
 On Error Resume Next
 Sheets(1).Select
 Worksheets.Add
 Sheets(1).Name = "Combined"
 For J = 2 To Sheets.Count
   Sheets(J).Activate
   Range("A1.I1").Select
   Selection.Copy
   Sheets(1).Activate
   Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
 Next
End Sub

 

Tags: , , , ,
-

Comments are closed.


  • Count per Day

    • 40Visitors today:
    • 42Visitors per day:
    • 0Visitors currently online:
  • ScrapBook Software - MyMemoriesSuite
  • Latest Pins on Pinterest

    • fisches

    • Free baby quilt pattern by Kirsty at Bonjour Quilts; made with Karen Lewis' Blueberry Park

    • flying geese

    • Martingale - Moda All-Stars - Mini Marvels

    • Simply Pieced: Flying Geese

    • Flock Of Seagulls Quilt Kit | Keepsake Quilting

    • Jaime's Cotton and Steel Four Winds Quilt | Fancy Tiger Crafts

    • I have got to do this block!!http://cheaperthantherapyquilting.blogspot.com/#

    • En toen kwam beer! | sommeke

    • Rainbow Geese in the Forest