Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 (A1:D3) 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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
Hi K
Start here http://www.rondebruin.nl/copy5.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "K" wrote in message ... 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 (A1:D3) 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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 "K" wrote in message ... 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. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 ??? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "K" wrote in message ... 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. |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 (MVP - Excel) "K" wrote in message ... 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 (A1:D3) 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. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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". -- Rick (MVP - Excel) "Rick Rothstein" wrote in message ... 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 (MVP - Excel) "K" wrote in message ... 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 (A1:D3) 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. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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. |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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 -- Rick (MVP - Excel) "K" wrote in message ... 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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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? |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
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. -- Rick (MVP - Excel) "K" wrote in message ... 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? |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data into sheets
Thanks lot Rick for all your help and time.
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy data to different sheets | Excel Worksheet Functions | |||
Copy data to new sheets | Excel Programming | |||
Copy data to multiple sheets | Excel Worksheet Functions | |||
Copy data to sheets by name | Excel Programming | |||
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? | Excel Worksheet Functions |