Copy all values in a row until blank then copy to another sheet

[markaxtell]

Hi,

I currently have a list of names that will always be a variable number so for example will be column K down to max number of 100 and i want to be able to copy all the names until the blank column and then paste them to another sheet.

Need this to be macro as aware you can do this with specialcells etc

Thanks in advance for help

 

[markaxtell]

I currently have this

Sub trythis()
Sheets("Sheet1").Range("k1").CurrentRegion.Copy Sheets("Sheet2").Range("c1")
End Sub

But it does not seem to work.

I want to copy all of the data it finds from K1 until row where it is blank then copy it to another sheet starting at C1 down

 

[GK039]

Hi,

I currently have a list of names that will always be a variable number so for example will be column K down to max number of 100 and i want to be able to copy all the names until the blank column and then paste them to another sheet.

Need this to be macro as aware you can do this with specialcells etc

Thanks in advance for help

The code will copy your names (you choose the cell where your names begin) and paste them to sheet2 starting from whichever cell you want.

Sub CopyNames()
Dim Lrow As Long
Dim Answer As String, CopyTo As String
Dim CopyRng As Range
Application.ScreenUpdating = False
Answer = InputBox("Please enter your starting cell", "Copy Names")
Lrow = Range(Answer).End(xlDown).Row
MsgBox Lrow
Set CopyRng = Range(Answer & ":" & Range(Answer).End(xlDown).Address)
CopyRng.Copy
Worksheets(2).Activate
CopyTo = InputBox("Please enter the cell to copy", "Copy Names")
Range(CopyTo).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

George

 

[markaxtell]

The code will copy your names (you choose the cell where your names begin) and paste them to sheet2 starting from whichever cell you want.

Sub CopyNames()
Dim Lrow As Long
Dim Answer As String, CopyTo As String
Dim CopyRng As Range
Application.ScreenUpdating = False
Answer = InputBox("Please enter your starting cell", "Copy Names")
Lrow = Range(Answer).End(xlDown).Row
MsgBox Lrow
Set CopyRng = Range(Answer & ":" & Range(Answer).End(xlDown).Address)
CopyRng.Copy
Worksheets(2).Activate
CopyTo = InputBox("Please enter the cell to copy", "Copy Names")
Range(CopyTo).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

George

geroge, thanks for that but how do i get it to do it without the input box?

 

[GK039]

We can leave it out if the ranges do not change.

If it is always Column K where the names are and always Sheets(2),column C where you want the names to be copied I will amend the code leaving out the input boxes. I just included it in case the ranges were not the same

 

[markaxtell]

So what would the code look like and also i would like it if could paste special just the value's and not copy the formatting?

 

[GK039]

This will do it

Sub CopyNames()
Dim Lrow As Long
Dim CopyRng As Range
Application.ScreenUpdating = False
Lrow = Range("k2").End(xlDown).Row
'MsgBox Lrow
Set CopyRng = Range("k2" & ":" & "k" & Lrow)
CopyRng.Copy
Worksheets(2).Activate
Range("c1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[GK039]

And this if you don't want the formating to be copied

Sub CopyNames()
Dim Lrow As Long
Dim CopyRng As Range
Application.ScreenUpdating = False
Lrow = Range("k2").End(xlDown).Row
'MsgBox Lrow
Set CopyRng = Range("k2" & ":" & "k" & Lrow)
CopyRng.Copy
Worksheets(2).Range("c1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[markaxtell]

that works but i need to run the macro in sheet2 (Summary) where the data will be copied to from Sheet1 (Data).

Sorry for being so specail!

 

[GK039]

<TABLE style="WIDTH: 240pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=320><COLGROUP><COL style="WIDTH: 48pt" span=5 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 240pt; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8; mso-ignore: colspan" height=17 width=320 colSpan=5>Developer Tab ---> Insert Button in the Forms Control Area</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8; mso-ignore: colspan" height=17 colSpan=5>Right Click the button ---> Assign Macro --->Choose Copy Names

and use the following code


</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD></TR></TBODY></TABLE>

Sub CopyNames()
Dim Lrow As Long
Dim CopyRng As Range
Application.ScreenUpdating = False
Worksheets("Data").Activate
Lrow = Range("k2").End(xlDown).Row
'MsgBox Lrow
Set CopyRng = Range("k2" & ":" & "k" & Lrow)
CopyRng.Copy
Worksheets("Summary").Range("c1").PasteSpecial Paste:=xlPasteValues
Worksheets("Summary").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub