• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to copy rows

shaka

New Member
Hi folks


I am looking for VBA code to copy data to another worksheet


what I am trying to do is have a macro that will copy rows in sheet1 to sheet2 if column C has a value then copy the next row if it has data, if the next row is blank it will look for the next row which column C has a value and copy that to a sheet2


SHEET1

A B C

1 2.00

2 Hat

3

4 data

5

6

7 5.00

8 Glove

9 Hat


SHEET2

A B C

1 2.00

2 Hat

3 5.00

4 Glove

5 Hat
 
Dear Shaka,


I need some clarifications, you told that if C1 has value, then it should copy the same entire row and paste it on Sheet2, if C1 haven't any value, then it should go for next row i.e C2 and doing some process. Is that right?


As per your example, you have taken all the values except data, Is there any other criteria.


Please let me know.


Vijay
 
Hi thanks for your reply, sorry tried to explain it as best I could I will try and explain it a little better


I need a macro to look at each row if column C in the row has a value copy that row and subsequent rows until it reaches a blank row, where it will then start the next row looking for a value in C again and so on


row1 - column A has text

row2 - column C has text (C has a value so this row will be copied)

row3 - column B has text (no blank row reached so copying row continues)

row4 - blank row - Stop copying

row5 - blank row

row6 - blank row

row7 - column C has a value (start copying again)

row8 - blank row (stop copying)


continue this down to row probably 5000 should be enough

rows will be copied to another worksheet
 
I'm sure there is probably a better way but try:

[pre]
Code:
Sub CopyData()

Dim CopyCellAdd As String
Dim i As Integer
Dim EndRow As Long

Application.ScreenUpdating = False

i = 1

Sheets("Sheet1").Select

'find last row of data
EndRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Range("A1").Select
Do
If Not IsEmpty(ActiveCell.Offset(0, 2)) Then
Do
CopyCellAdd = ActiveCell.Address
ActiveCell.EntireRow.Copy
Sheets("Sheet2").Select
Cells(i, 1).Select
ActiveSheet.Paste
i = i + 1
Sheets("Sheet1").Select
Range(CopyCellAdd).Select
ActiveCell.Offset(1, 0).Select
Loop Until Application.CountA(ActiveCell.EntireRow) = 0
End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Row = EndRow + 2

Application.ScreenUpdating = True
End Sub
[/pre]
 
DaveTurton looks like you got have delivered just what I was looking for thank you so much.
 
Hi .


I have a code for this.


Sub sheets()


sheets("sheet1").Select


Dim yy As String, y1 As String


ActiveSheet.UsedRange.Columns.Select

Selection.Copy

Selection.Copy

Selection.Copy


sheets("sheet2").Select


Dim lastrowx As Long

Dim celladdx As String, col As String


lastrowx = ActiveSheet.UsedRange.rows.count

celladdx = "A" & Trim(lastrowx + 1)


ActiveSheet.Range(celladdx).Select

ActiveSheet.Paste


ActiveWorkbook.Save

ActiveWorkbook.Close

ActiveWorkbook.Close


End Sub


also if you want to copy data from different files to a single sheet.

i.e copying from sheets/worksbooks day1, day2 , day3 to work book final_sheet please refer to below code


Sub sheet1()


Application.ScreenUpdating = False


Workbooks.Open "<path>Day 1"

sheets("Day 1").Select

Cells.Select

Selection.Copy


Workbooks.Add

ActiveSheet.Paste

ActiveSheet.name = "Final"


ActiveWorkbook.SaveAs "C:Documents and SettingsNavo.DELLD400DesktopFinal_Sheets.xls"


ActiveWorkbook.Close

ActiveWorkbook.Close


End Sub


Sub sheet2()


Workbooks.Open "<path>Day 2"

sheets("Day 2").Select


Dim yy As String, y1 As String


ActiveSheet.UsedRange.Columns.Select

Selection.Copy

Selection.Copy

Selection.Copy


Workbooks.Open "<path>Final_Sheets.xls"

sheets("Final").Select


Dim lastrowx As Long

Dim celladdx As String, col As String


lastrowx = ActiveSheet.UsedRange.rows.count

celladdx = "A" & Trim(lastrowx + 1)


ActiveSheet.Range(celladdx).Select

ActiveSheet.Paste


ActiveWorkbook.Save

ActiveWorkbook.Close

ActiveWorkbook.Close


End Sub


Sub sheet3()


Workbooks.Open "<path>Day 3"

sheets("Day 3").Select


Dim yy As String, y1 As String

ActiveSheet.UsedRange.Columns.Select

Selection.Copy

Selection.Copy

Selection.Copy


Workbooks.Open "<path>Final_Sheets.xls"

sheets("Final").Select


Dim lastrowx As Long

Dim celladdx As String, col As String


lastrowx = ActiveSheet.UsedRange.rows.count

celladdx = "A" & Trim(lastrowx + 1)


ActiveSheet.Range(celladdx).Select

ActiveSheet.Paste


ActiveWorkbook.Save

ActiveWorkbook.Close

ActiveWorkbook.Close


End Sub


Sub final_sheet()


sheet1

sheet2

sheet3


End Sub


Thank you

LNK
 
Back
Top