Another question

T

TIMOTHY

i have two sheets in which one is blank

using vba code i want to copy column one three seven and paste them into another sheet
 
B

benmcclave

i have two sheets in which one is blank



using vba code i want to copy column one three seven and paste them into another sheet

Try this (you may need to change sheet names as applicable)

Sub CopyColumns()
Sheets("Sheet1").Range("A:A,C:C,G:G").Copy _
Sheets("Sheet2").Range("A1")
End Sub
 
T

TIMOTHY

Try this (you may need to change sheet names as applicable)

Sub CopyColumns()
Sheets("Sheet1").Range("A:A,C:C,G:G").Copy _
    Sheets("Sheet2").Range("A1")
End Sub

suppose column headings of that three are suppliername, contact, and
emailid. And if i dont know the column no. In that case?
 
T

TIMOTHY

Try this (you may need to change sheet names as applicable)

Sub CopyColumns()
Sheets("Sheet1").Range("A:A,C:C,G:G").Copy _
    Sheets("Sheet2").Range("A1")
End Sub

suppose column headings of that three are suppliername, contact, and
emailid. And if i dont know the column no. In that case?
 
T

TIMOTHY

Try this (you may need to change sheet names as applicable)

Sub CopyColumns()
Sheets("Sheet1").Range("A:A,C:C,G:G").Copy _
    Sheets("Sheet2").Range("A1")
End Sub

suppose column headings of that three are suppliername, contact, and
emailid. And if i dont know the column no. In that case?
 
B

benmcclave

suppose column headings of that three are suppliername, contact, and
emailid. And if i dont know the column no. In that case?

Try:

Sub FindandCopy()
Dim x As Long
Dim sFind(1 To 3) As String
Dim sFound As String

'Update values below as necessary
sFind(1) = "suppliername"
sFind(2) = "contact"
sFind(3) = "emailid"

On Error Resume Next
For x = 1 To 3
'Change "Rows("1:1")" to whatever range includes your column headings
sFound = sFound & Rows("1:1").Find(What:=sFind(x), After:=Cells(1, 1), LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).EntireColumn.Address & ","
Next x
On Error GoTo 0

If Len(sFound) > 1 Then
sFound = Left(sFound, Len(sFound) - 1)
Sheets("Sheet1").Range(sFound).Copy _
Sheets("Sheet2").Range("A1")
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top