Copy data into sheets

[K]

Hi all, I have four Sheets with the names "Summary , ddd , uuu , yyy"
in a workbook. I have data in Sheet("Summary") like see below

rows A B C D......col
1 xx rec ddd 1234
2 xx arc ddd 4568
3 xx rec ddd 356
4 ss arc uuu 1234
5 ss rec uuu 4566
6 aa arc yyy 1234
7 aa rec yyy 8999

i want macro which should check value of cells of column C and if that
value match with any sheet name in workbook then macro should copy
data from column A to D of same row of column C cell value and paste
it into matching name sheet. For example according to above data Range
(A13) should be copied to Sheet("ddd") as value in Range(C1:C3) is
"ddd" and it matches with the sheet name. And like this so on. Please
can any friend tell me any simple macro which can do this job.

 

[Ron de Bruin]

Hi K

Start here
http://www.rondebruin.nl/copy5.htm

 

[K]

Hi Ron, thanks for replying. I did look first on your website before
posting my question to this group and your code is quite big and bit
complicated for me. I am looking for small code which do the job.
I'll be very greatful if you can simplify your code for my need.

 

[JP Ronse]

Hi K,

Try ...

Sub CopyRange()
Dim rng As Range
Dim cll As Range
Dim lngDDD As Long
Dim lngUUU As Long
Dim lngYYY As Long

lngDDD = Sheets("ddd").Range("A1").CurrentRegion.Rows.Count
If Sheets("ddd").Range("A1") = "" Then lngDDD = 0
lngUUU = Sheets("uuu").Range("A1").CurrentRegion.Rows.Count
If Sheets("uuu").Range("A1") = "" Then lngUUU = 0
lngYYY = Sheets("yyy").Range("A1").CurrentRegion.Rows.Count
If Sheets("yyy").Range("A1") = "" Then lngYYY = 0

Sheets("Summary").Activate
Set rng = Range(Range("C1"), Range("C1").End(xlDown))

For Each cll In rng
Select Case cll
Case "ddd"
Range(Cells(cll.Row, 1), Cells(cll.Row, 4)).Copy
Sheets("ddd").Cells(1, 1).Offset(lngDDD, 0)
lngDDD = lngDDD + 1
Case "uuu"
Range(Cells(cll.Row, 1), Cells(cll.Row, 4)).Copy
Sheets("uuu").Cells(1, 1).Offset(lngUUU, 0)
lngUUU = lngUUU + 1
Case "yyy"
Range(Cells(cll.Row, 1), Cells(cll.Row, 4)).Copy
Sheets("yyy").Cells(1, 1).Offset(lngYYY, 0)
lngYYY = lngYYY + 1
End Select
Next cll
End Sub

This is surely not the best approach but is simple and does what you need.

Wkr,

JP

 

[Don Guillett]

IMO the easiest is to have a looping macro that filters and copies the
filtered data to each sheet.
If desired, send your file to my address below along with this msg and
a clear explanation of what you want and before/after examples.

 

[Ron de Bruin]

If a small code can do the job I will use that but
you must check a lot of stuff so I can not make it easier

What's the problem when you have a few more code lines ???

 

[Rick Rothstein]

Here is my offering...

Sub CopyData()
Dim X As Long, LastRow, LastSummaryRow As Long, WS As Worksheet
On Error Resume Next
With Worksheets("Summary")
LastSummaryRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = 2 To LastSummaryRow
Set WS = Worksheets(.Cells(X, "C").Value)
If Err.Number = 0 Then
LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
If LastRow = 1 And WS.Range("A1").Value = "" Then LastRow = 0
.Cells(X, "A").Resize(, 4).Copy WS.Cells(LastRow + 1, "A")
Else
Err.Clear
End If
Next
End With
End Sub

The code assumes your data on the Summary sheet starts at Row 2. If it
starts on a different row, change the 2 in the For statement to the row
number your data actually starts on.

 

[Rick Rothstein]

Just so you know, I included the error trapping code in my macro because you
wrote this in your initial request...

"macro which should check value of cells of column C and
if that value match with any sheet name in workbook then..."

The "if that value match with any sheet name" led me to believe there could
be entries in Column C that do *not* match a worksheet name in the workbook.
**IF** the entries in Column C will **ALWAYS** contain the name of a
worksheet in the workbook, then the error trapping code is not necessary and
the macro becomes much simpler...

Sub CopyData()
Dim X As Long, LastRow, LastSummaryRow As Long, WS As Worksheet
With Worksheets("Summary")
LastSummaryRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = 2 To LastSummaryRow
Set WS = Worksheets(.Cells(X, "C").Value)
LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
If LastRow = 1 And WS.Range("A1").Value = "" Then LastRow = 0
.Cells(X, "A").Resize(, 4).Copy WS.Cells(LastRow + 1, "A")
Next
End With
End Sub

Remember though, each entry in Column C **must** contain a valid worksheet
name or the above code will "bomb out".

 

[K]

Thanks a lot Rick Rothstein. the code you wrote the one without error
trapping is what i needed and it do the job brilliantly. You are
genious. Thanks again.

 

[K]

Just one more question Rick that lets say if i haven't got sheets
"ddd , uuu , yyy" in the workbook and this time i have sheet
("Summary") and sheet("Template") in the workbook, what adjustments i
need in your macro below that it should copy sheet("Template") and
give it the unique name from sheet("Summary").column("C") and copy
related data into new sheet. For example macro should copy sheet
("Template") and give it name "ddd" and then copy same row data from
column A to D of sheet("Summary") into sheet("ddd") and so on.

Your macro below
Sub CopyData()
Dim X As Long, LastRow, LastSummaryRow As Long, WS As Worksheet
With Worksheets("Summary")
LastSummaryRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = 2 To LastSummaryRow
Set WS = Worksheets(.Cells(X, "C").Value)
LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
If LastRow = 1 And WS.Range("A1").Value = "" Then LastRow = 0
.Cells(X, "A").Resize(, 4).Copy WS.Cells(LastRow + 1, "A")
Next
End With
End Sub

 

[Rick Rothstein]

This should do what you are asking for...

Sub CopyData()
Dim X As Long, LastRow, LastSummaryRow As Long, WS As Worksheet
On Error Resume Next
With Worksheets("Summary")
LastSummaryRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = 2 To LastSummaryRow
Set WS = Worksheets(.Cells(X, "C").Value)
If Err.Number > 0 Then
Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(X, "C").Value
Set WS = Worksheets(Worksheets.Count)
Err.Clear
End If
LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
If LastRow = 1 And WS.Range("A1").Value = "" Then LastRow = 0
.Cells(X, "A").Resize(, 4).Copy WS.Cells(LastRow + 1, "A")
Next
End With
End Sub

 

[K]

Hi Rick, Thanks again for replying. I used your above new code but i
am getting error on line
Set WS = Worksheets(.Cells(X, "C").Value)
and also just for knowledge why did you put error traping code in your
new code?

 

[Rick Rothstein]

Assuming you didn't change the code I posted, then do this... go into the VB
editor and click Tools/Options its menu bar, select the General tab, and
locate for the Error Trapping section... select the "Break in Class Module"
option (you could also select the "Break on Unhandled Errors" option if you
wish, but the "Break in Class Module" does the same thing and aids you a
little more in your debugging)... and leave that as your permanent setting.
The one I am guessing you had selected, "Break on All Errors", does exactly
what it says... it breaks on all errors, even if your code is trying to
manage the error. It's more of a debugging setting than a "use it all the
time" setting.

Once you make the above change, my code should work for you. The reason I
put the error trapping back in the code is because you changed your request
and it became required. Your original request assumed the worksheet would
always be available to be written to, so we did not have to check to see if
the code was attempting to write to a non-existent sheet. In your new
request, the possibility of a non-existent worksheet is now a reality (you
want to create the sheet when it doesn't exist), so I needed a way to see if
a sheet existed or not. The easiest way to do that is to attempt to write to
the sheet... if it is not there, an error is generated... my code uses the
error trap to decide if a new worksheet needs to be created or not.

 

[K]

Thanks lot Rick for all your help and time.