Capture client data from large master client worksheet and place individual
client data in separate worksheets.
The script below accomplishes what I want up to the eleventh row of
worksheet #1 in an excel file.
It captures the header row and the 11 rows of data for the 1st client .
Opens ,names a new work sheet and then pastes the 11 rows of data into said
worksheet.
The new worksheet is named by capturing a cell in the Worksheet #1
The next 10 rows are for another client and so on for 281 rows.
I would like the macro to proceed to the next 11 rows of data add a and
name a worksheet
and repeat the cut paste and repeat this until it reaches the end of the
worksheet.
==============================================================
Sub Sample()
Dim ws As Worksheet, tmpSht As Worksheet
Dim LastRow As Long, i As Long, j As Long
'~~> Change Sheet1 to the sheet which has all the data
Set ws = Sheets("Sheet1")
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
If LastRow < 4 Then Exit Sub
For i = 11 To LastRow
If DoesSheetExist(.Range("A" & i).Value) Then
Set tmpSht = Sheets(.Range("A" & i).Value)
Else
Sheets.Add After:=Sheets(Sheets.Count)
Set tmpSht = ActiveSheet
tmpSht.Name = .Range("c" & 3).Value
End If
.Rows("1:10").Copy tmpSht.Rows(1)
For j = 1 To 11
tmpSht.Columns(j).ColumnWidth = .Columns(j).ColumnWidth
Next j
.Rows(i).Copy tmpSht.Rows(11)
Next
End With
End Sub
Function DoesSheetExist(Sht As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets(ws)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExist = True
End Function
--
Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To post to this group, send email to [email protected].
To unsubscribe from this group, send email to
[email protected].
Visit this group at http://groups.google.com/group/excel-macros?hl=en.
