VBA Code to Copy data for New Sheet

suresh ullanki

Board Regular
Joined
Apr 29, 2013
Messages
67
Hi,

I am new to VBA and struggling to copy data to New workbook. I have wrongly referred the workbook. I want to copy data from ws1 to new workbook. but it is coping to ws2.I have to run macros from ws2 book. as I have placed more macros in ws2. macro is not running when I add new workbook. Please help

Sub Button1_Click()
MsgBox "Please select Source File"
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
Workbooks.Open Filename:=NewFN
End If
Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim i As Long

Set ws2 = ThisWorkbook.Sheets("Format")
Set wkb = ActiveWorkbook
Set ws1 = wkb.Sheets("Headcount Reg")
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To ws1.UsedRange.Columns.Count 'This can be changed to 70 if there are columns after BQ that are not copied.
Select Case i
Case Is <= 6
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i)
Case 8 To 14
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i - 1)
Case 15 To 16
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 3)
Case 17 To 38
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)
Case 39 To 45
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 7)
Case 46 To 47
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 23)
Case 48 To 58
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i + 5)

End Select
Next i
ws2.Activate
ws2.SaveAs Filename:="Schedule 7_Append", FileFormat:=xlCSV, CreateBackup:=False
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Delete
Range("E2", "E50000").NumberFormat = "DD-MMM-YYY"
Range("f2", "f50000").NumberFormat = "DD-MMM-YYY"
Range("s2", "s50000").NumberFormat = "DD-MMM-YYY"
Cells.Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top