macro to copy columns

[bernd]

Hello,

I need a macro that copies columns to a specific sheet. The steps that
have to be taken:
1. the macro is called
2. a form asks the user for a number. This number is the amount of
columns counting from left to right that have to be copied, starting
with colomn K. (So, if the number is 3, column K, L and M have to be
copied)
3. The copied columns have to be pasted on another worksheet. Also
starting from column K.
Notice: the cells that will be copied contain formulas, so paste
special+values should be used.

Can someone realize such a macro?

Many thanks!

 

[Vergel Adriano]

bernd,

assuming the target sheet is Sheet2, maybe something like this:

Sub test()

Dim iColumns As Integer

iColumns = InputBox("Enter how many columns to copy")
Range(Cells(1, 11), Cells(1, 10 + iColumns)).EntireColumn.Copy
Sheet2.Range("K1").PasteSpecial xlPasteValues

End Sub

 

[Vergel Adriano]

bernd,

assuming the target sheet is Sheet2, maybe something like this:

Sub test()

Dim iColumns As Integer

iColumns = InputBox("Enter how many columns to copy")
Range(Cells(1, 11), Cells(1, 10 + iColumns)).EntireColumn.Copy
Sheet2.Range("K1").PasteSpecial xlPasteValues

End Sub

 

[JE McGimpsey]

One way:

Public Sub CopyVariableNumberOfColumns()
Const cnCOLSTART As Long = 11 'Col K
Dim vResult As Variant
Dim rCopy As Range

With Sheets("Sheet1")
Do
vResult = Application.InputBox( _
Prompt:="Number of columns to copy:", _
Title:="Copy Columns", _
Type:=1, _
Default:=1)
If vResult = False Then Exit Sub 'user cancelled
Loop Until vResult > 0 And _
((vResult + cnCOLSTART - 1) <= .Columns.Count)
Set rCopy = Intersect(.UsedRange, _
.Columns(cnCOLSTART).Resize(, vResult))
With rCopy
Worksheets("Sheet2").Cells(1, 1).Resize( _
.Rows.Count, .Columns.Count).Value = .Value
End With
End With
End Sub

 

[Tom Ogilvy]

Sub ABC()
Dim ans as String
ans = InputBox("How many columns")
if not isnumeric(ans) then exit sub
With worksheets("Sheet1")
.Range("K:K").Resize(rows.count, clng(ans)).copy
End with
Worksheets("Sheet2")
.Range("K:K").PasteSpecial xlValues
End With
End sub

 

[bernd]

Finally I've used Mc Gimpsey's solution. After editing the macro to
copy to colomn K (=11) of sheet2.

In the other two solutions I ran into some errors.

Many thanks for your fast replies, to all of you!

 

[Tom Ogilvy]

Sub A_copyColumns()
Dim ans As String
ans = InputBox("How many columns")
If Not IsNumeric(ans) Then Exit Sub
With Worksheets("Sheet1")
.Range("K:K").Resize(Rows.Count, CLng(ans)).Copy
End With
With Worksheets("Sheet2")
.Range("K:K").PasteSpecial xlValues
End With
End Sub

worked fine for me. Looks like I left out a With statement. Sorry if the
typo caused you any discomfort.