?
Solved

Copy data from one tab and paste into a correspond worksheet

Posted on 2014-03-03
2
Medium Priority
?
328 Views
Last Modified: 2014-03-03
I’m trying to come up with a sub routine that will copy the data from the ‘dataSheet’ tab and paste it into its corresponding ‘Zone’ tab.  You’ll notice that the first column in the datasheet has names that correspond to a particular ‘Zone’ worksheet.

If you look at my attached file, you’ll get the basic idea of what I’m trying to accomplish.  I need this routine to be dynamic in that I could have a different number of “Zone” tabs from month to month.
Example-Sheet.xlsx
0
Comment
Question by:KP_SoCal
2 Comments
 
LVL 39

Accepted Solution

by:
nutsch earned 2000 total points
ID: 39902047
Something like this?

Sub SplitListIntoZones()
'split list into individual worksheets
Dim lLoop As Long, arrData As Variant
Dim shtData As Worksheet, lgCol As Long, rgSel As Range
Dim cUnique As New Collection, shtDest As Worksheet
Const blTitles As Boolean = True                    'true if the data has titles, false otherwise
Const sColumn As String = "A"                       'Which column should the list be split on

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

lgCol = Cells(1, sColumn).Column
Set rgSel = Cells(1, 1).CurrentRegion

Set shtData = ActiveSheet

With shtData
    'load the column into an array for faster processing
    arrData = .Range(.Cells(1, sColumn), .Cells(.Rows.Count, sColumn).End(xlUp)).Value
    
    'load the array content in a collection, to keep individual values only
    On Error Resume Next
    
    For lLoop = LBound(arrData, 1) To UBound(arrData, 1)
        cUnique.Add arrData(lLoop, 1), CStr(arrData(lLoop, 1))
    Next
    
    On Error GoTo 0
    
    'for each individual value, filter the list, copy the results to a new worksheet
    For lLoop = 1 To cUnique.Count
        .AutoFilterMode = False
        rgSel.CurrentRegion.AutoFilter Field:=lgCol - rgSel.CurrentRegion.Column + 1, Criteria1:=cUnique(lLoop)
        Set shtDest = Sheets.Add
        shtDest.Name = cUnique(lLoop)
        rgSel.CurrentRegion.Copy shtDest.Cells(4, 2)
    Next
    
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True 'reenable ScreenUpdating
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

Open in new window


Thomas
0
 

Author Closing Comment

by:KP_SoCal
ID: 39902211
Thank you!  This is exactly what I needed!  Also, I really appreciate the explanation comments in the code. ;-)
0

Featured Post

Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…

807 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question