Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 395
  • Last Modified:

Copy Columns

What I am trying to do is copy multiple rows in a worksheet and then create another worksheet in the same workbook and paste the columns. It is only working for one column and I already have to have 'Sheet2' created. I also need to apply 'Trim' to the column. Here is my code

oSheet.Range("B8:B900").Copy ' Part Number
set oSheet = oBook.Worksheets("Sheet2")
oSheet.Activate 'The sheet needs to be active
oSheet.Range("A3").Select
oSheet.Paste

What I tried to do was this:
oSheet.Range("B8:B900").Copy ' Part Number
oSheet.Range("A8:A900").Copy ' Serial
oSheet.Range("H8:H900").Copy ' Name
set oSheet = oBook.Worksheets("Sheet2")
oSheet.Activate 'The sheet needs to be active
oSheet.Range("A3").Select
oSheet.Range("C3").Select
oSheet.Range("D3").Select
oSheet.Paste

Can you help?

Thank you


0
drezner7
Asked:
drezner7
  • 11
  • 8
  • 2
1 Solution
 
viralypatelCommented:
write a macro to loop thorough the range you pasted and make it trim the values in each cell in the range.
call the macro in your code after you paste.
0
 
drezner7Author Commented:
I would prefer not to use Macro. I really would like to do it in VbScript
0
 
viralypatelCommented:
then you could loop through the target range and go on trimming the values.
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
Bill PrewCommented:
Where are you trying to copy from / to?

~bp
0
 
drezner7Author Commented:
I am trying to copy from Worksheet 1 to Worksheet 2 in the same Workbook
0
 
Bill PrewCommented:
Yes, what columns are going to what columns?  It looks like you want to get:

oSheet.Range("B8:B900").Copy ' Part Number
oSheet.Range("A8:A900").Copy ' Serial
oSheet.Range("H8:H900").Copy ' Name

But where do you want them in Sheet2, should it be columns A, B and C?

~bp
0
 
drezner7Author Commented:
yes
0
 
drezner7Author Commented:
Columns A, B, C... will be good
0
 
Bill PrewCommented:
For the copy, I think it should be as simple as:

    Sheet1.Range("B8:B900").Copy Destination:=Sheet2.Range("A1")
    Sheet1.Range("A8:A900").Copy Destination:=Sheet2.Range("B1")
    Sheet1.Range("H8:H900").Copy Destination:=Sheet2.Range("C1")

Open in new window

~bp
0
 
drezner7Author Commented:
it does not work. Herei s the beginning portion of the code


Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel File|*.xls|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Scripts"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit
Else
    Wscript.Echo objDialog.FileName
End If


Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(objDialog.FileName, False, False)
oExcel.Visible = True ' Do not display excel window
Set oSheet = oBook.Sheets(1)


Sheet1.Range("B8:B900").Copy Destination:=Sheet2.Range("A1")
    Sheet1.Range("A8:A900").Copy Destination:=Sheet2.Range("B1")
    Sheet1.Range("H8:H900").Copy Destination:=Sheet2.Range("C1")

0
 
Bill PrewCommented:
Sorry, the code I gave you was VBA code, it needs some adjustment for VBS usage. Give this a try.

Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel File|*.xls|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Scripts"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit
Else
    Wscript.Echo objDialog.FileName
End If


Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(objDialog.FileName, False, False)
oExcel.Visible = True ' Do not display excel window
Set oSheet1 = oBook.Sheets(1)
Set oSheet2 = oBook.Sheets(2)

oSheet1.Range("B8:B900").Copy Destination:=oSheet2.Range("A1")
oSheet1.Range("A8:A900").Copy Destination:=oSheet2.Range("B1")
oSheet1.Range("H8:H900").Copy Destination:=oSheet2.Range("C1") 

Open in new window

~bp
0
 
drezner7Author Commented:
It is throwing a error in this line
oSheet1.Range("B8:B900").Copy Destination:=oSheet2.Range("A3") ' Part Number

Error "Expected Statement"

Everything looks correct so, I am confused.
0
 
drezner7Author Commented:
I changed the line to look like this:
oSheet1.Range("B8:B900").Copy Destination = oSheet2.Range("A3") ' Part Number

It opens the excel sheet, but it remains open and it does not copy and paste to Worsheet 2
0
 
Bill PrewCommented:
Let me try a VBS test here, maybe that VBA syntax isn't supported, and we might have to do it the long way.

~bp
0
 
Bill PrewCommented:
Okay, give this a try:

oSheet1.Activate
oSheet1.Range("B8:B900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("A1").Select
oSheet2.Paste

oSheet1.Activate
oSheet1.Range("A8:A900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("B1").Select
oSheet2.Paste

oSheet1.Activate
oSheet1.Range("H8:H900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("C1").Select
oSheet2.Paste

Open in new window

~bp
0
 
drezner7Author Commented:
The Excel spreadsheet just stays open....here is my entire code:

'Script to compare data and pull the corresponding data elements

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If


'Input Boxes to request user input


reportname = inputBox("Please Enter Name Of Report?",,"Reports")


Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel File|*.xls|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\Scripts"
intResult = objDialog.ShowOpen
 
If intResult = 0 Then
    Wscript.Quit
Else
    Wscript.Echo objDialog.FileName
End If


Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(objDialog.FileName, False, False)
oExcel.Visible = True ' Do not display excel

oSheet1.Activate
oSheet1.Range("B8:B900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("A1").Select
oSheet2.Paste

oSheet1.Activate
oSheet1.Range("A8:A900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("B1").Select
oSheet2.Paste

oSheet1.Activate
oSheet1.Range("H8:H900").Select
oExcel.Selection.Copy
oSheet2.Activate
oSheet2.Range("C1").Select
oSheet2.Paste


iRow = 3

With oSheet.Range("B3:B850").formula="=IF(ISNA(VLOOKUP(A3,'\\pusehf15\css\CSE\F135\ALIS\Sustainment_Data\Parts Saleability\[Saleability Matrix.xlsx]Sheet1'!$A$3:$B$795,2,0)),""Part Not Found"",IF(VLOOKUP(A3,'\\pusehf15\css\CSE\F135\ALIS\Sustainment_Data\Parts Saleability\[Saleability Matrix.xlsx]Sheet1'!$A$3:$B$795,2,0)=0,""Saleable"",(VLOOKUP(A3,'\\pusehf15\css\CSE\F135\ALIS\Sustainment_Data\Parts Saleability\[Saleability Matrix.xlsx]Sheet1'!$A$3:$B$795,2,0))))"
   
End With



oExcel.DisplayAlerts = False

OExcel.Save "C:\Testing\ Compare\Reports\Report.xls"
oExcel.quit
oOut.Close       
0
 
Bill PrewCommented:
Did the cells get copied?

~bp
0
 
drezner7Author Commented:
No cells were copied... it just stayed opened
0
 
drezner7Author Commented:
I found the issue.... I had removed the Set oSheet1 =

THank you
0
 
drezner7Author Commented:
Excellent code.... This website rocks... Thank you very Billprew I really appreciate all the help
0
 
Bill PrewCommented:
Great, glad that worked, thanks.

~bp
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 11
  • 8
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now