Trying to copy AREAs to the sheet of the employee whose name is the same as "Ar" in the - For Each Ar In Columns("A").SpecialCells(xlConstants).Areas

If current Ar = Name 1 then the AREA should go to the sheet named Name 1.

I'm using Name 1, Name 2 etc, as sheet names and employee names.

"Main" sheet column 1 has Name n and data for Name n is in columns B to E down any number of rows. Say 5 to 45, varies.

There is a one blank row between AREAs.

The "Set ArCpy As..." works just fine, can't get the copy-to-sheet-name thing correct.

Thanks,
Howard

Sub Staff_Info_To_Staff_Sheet()
Dim Ar As Range
Dim ArRow As Long, ArDwn As Long
Dim ArCpy As Range
Dim sNme As Worksheet

For Each Ar In Columns("A").SpecialCells(xlConstants).Areas

ArDwn = Ar.Offset(, 1).End(xlDown).Row
'Set sNme.Name = Ar.Offset(0, 0)
Set ArCpy = Range(Cells(Ar.Row, 2), Cells(ArDwn, 5))

ArCpy.Copy Sheets(sNme).Range("A" & Rows.Count).End(xlUp)(2)

Next

End Sub

Hi Howard,

Am Sun, 25 Oct 2015 17:30:29 -0700 (PDT) schrieb L. Howard:

Trying to copy AREAs to the sheet of the employee whose name is the same as "Ar" in the - For Each Ar In Columns("A").SpecialCells(xlConstants).Areas

If current Ar = Name 1 then the AREA should go to the sheet named Name 1.

I'm using Name 1, Name 2 etc, as sheet names and employee names.

"Main" sheet column 1 has Name n and data for Name n is in columns B to E down any number of rows. Say 5 to 45, varies.

There is a one blank row between AREAs.

can you send me an example workbook?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

can you send me an example workbook?


Regards
Claus B.

Hi Claus, thanks for taking a look.

Here is my test workbook.
There are probably other ways to copy the data, I was interested in using the AREAs for the most part. A example to myself, no OP here.

https://www.dropbox.com/s/apxjwd34sg...copy.xlsm?dl=0

Howard

Hi Howard,

Am Mon, 26 Oct 2015 00:19:54 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/apxjwd34sg...copy.xlsm?dl=0

please download your workbook from
https://onedrive.live.com/redir?resi...=folder%2cxlsm


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Mon, 26 Oct 2015 08:35:45 +0100 schrieb Claus Busch:

https://onedrive.live.com/redir?resi...=folder%2cxlsm

or try it this way (macro also at OneDrive in your workbook Module3):

Sub CopyAreas()
Dim LRow As Long, i As Long, n As Long
Dim varFirst() As Variant, varLast() As Variant
Dim rngC As Range, myRng As Range

With Sheets("Main")
LRow = .Cells(Rows.Count, 2).End(xlUp).Row
'Writing the last row of the areas in an array
For Each rngC In .Range("B1:B" & LRow +
1).SpecialCells(xlCellTypeBlanks)
ReDim Preserve varLast(i)
varLast(i) = rngC.Row - 1
i = i + 1
Next
'Writing the first row of the areas in an array
ReDim Preserve varFirst(UBound(varLast))
varFirst(n) = 2
For i = LBound(varLast) To UBound(varLast) - 1
n = n + 1
varFirst(n) = varLast(i) + 3
Next
'Copying the areas
For i = LBound(varFirst) To UBound(varFirst)
Set myRng = .Range(.Cells(varFirst(i), 2), .Cells(varLast(i),
5))
Sheets(.Cells(varFirst(i) - 1, 1).Value).Cells(Rows.Count,
1).End(xlUp)(2) _
.Resize(myRng.Rows.Count, 4).Value = myRng.Value
Next
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Monday, October 26, 2015 at 1:27:32 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Mon, 26 Oct 2015 08:35:45 +0100 schrieb Claus Busch:

https://onedrive.live.com/redir?resi...=folder%2cxlsm

or try it this way (macro also at OneDrive in your workbook Module3):

Sub CopyAreas()
Dim LRow As Long, i As Long, n As Long
Dim varFirst() As Variant, varLast() As Variant
Dim rngC As Range, myRng As Range

With Sheets("Main")
LRow = .Cells(Rows.Count, 2).End(xlUp).Row
'Writing the last row of the areas in an array
For Each rngC In .Range("B1:B" & LRow +
1).SpecialCells(xlCellTypeBlanks)
ReDim Preserve varLast(i)
varLast(i) = rngC.Row - 1
i = i + 1
Next
'Writing the first row of the areas in an array
ReDim Preserve varFirst(UBound(varLast))
varFirst(n) = 2
For i = LBound(varLast) To UBound(varLast) - 1
n = n + 1
varFirst(n) = varLast(i) + 3
Next
'Copying the areas
For i = LBound(varFirst) To UBound(varFirst)
Set myRng = .Range(.Cells(varFirst(i), 2), .Cells(varLast(i),
5))
Sheets(.Cells(varFirst(i) - 1, 1).Value).Cells(Rows.Count,
1).End(xlUp)(2) _
.Resize(myRng.Rows.Count, 4).Value = myRng.Value
Next
End With
End Sub


Regards
Claus B.

Thanks Claus, as always great stuff indeed.

Is the main problem with my initial code getting the AR name to become a sheet name is that AR is Dimmed as a Range and the sheet name must be a string?

Howard

Hi Howard,

Am Mon, 26 Oct 2015 03:03:04 -0700 (PDT) schrieb L. Howard:

Is the main problem with my initial code getting the AR name to become a sheet name is that AR is Dimmed as a Range and the sheet name must be a string?

the main problem is the loop through the cells:
For each Ar in Columns("A")
goes to each cell and the second loop gives already a wrong name and a
wrong range.

Your code revised:

Sub Staff_Info_To_Staff_Sheet()
Dim Ar As Range
Dim ArRow As Long, ArDwn As Long, LRow As Long
Dim myFirst As Long, myLast As Long, i As Long
Dim ArCpy As Range
Dim sNme As String

With Sheets("Main")
LRow = .Cells(Rows.Count, 2).End(xlUp).Row
myFirst = 1
For i = myFirst To LRow
sNme = .Cells(myFirst, 1)
If Len(.Cells(i, 2)) = 0 Then
Set ArCpy = .Range(.Cells(myFirst + 1, 2), .Cells(i - 1, 5))
Sheets(sNme).Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(ArCpy.Rows.Count, 4).Value = ArCpy.Value
myFirst = i + 1
End If
Next
End With

End Sub

Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Okay, I was sure I had a msgbox while testing that would show each Name n (no other code in the For Each...) and it would loop through all the names in column 1. So I was under the impression that the AREAs was making that possible instead of looping through each and every cell in column 1.

However, I cannot duplicate that now for whatever reason. Maybe I am going nuts and just thought I did that.<g

At any rate, these three codes should keep me off the streets for some time while I digest them.

Thank much, Howard

Hi Claus,

Okay, the Msgbox AR worked only if:

There were just the Name 1, Name 2 etc. in column 1

AND

only if there was NOT adjacent cells with data. Needed a blank row between each entry or the Msgbox AR errors out.

I suppose AREAs does not process consecutive cells and I added the additional data afterwards to simulate what a actual sheet may have on it.

So, as you say, the For Each looks at each cell.

With only Name 1, Name 2 etc. in column 1, it seems one could then pass that AR to a sheet name some how, since each is also a sheet name.

Howard

Hi Howard,

Am Mon, 26 Oct 2015 04:19:08 -0700 (PDT) schrieb L. Howard:

With only Name 1, Name 2 etc. in column 1, it seems one could then pass that AR to a sheet name some how, since each is also a sheet name.

I guess if you have the name in the first cell in column A and also in
the last cell in column E the code in Module2 is the easiest one.
If there is no name in column E or the names can change in order the
code in Module3 is more reliable.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Một ngày mới làm việc hiệu quả.