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
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