Excel VBA 操作 复制拷贝操作

Attribute VB_Name = "模块11"

Dim inputdate As String

Dim newbook As Workbook


Sub 提取数据()

Dim ws As Worksheet

Dim datestr As String

Dim phone As String

Dim money As String

Dim goods As String

Dim newws As Worksheet

Dim moneyint As Integer

inputdate = InputBox("请输入导出日期")

If inputdate = "" Then End

Dim name As String

name = Format(inputdate, "m-d")


Set ws = Worksheets(1)


Set newbook = Workbooks.Add
newbook.SaveAs Filename:=name & ".xlsx"


'ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) '添加一个新工作表在第一工作表前


Set newws = newbook.Worksheets(1)

newws.Cells(1, 1) = "手机号码"

newws.Cells(1, 2) = "金额"

newws.Cells(1, 3) = "产品"

newws.Cells(1, 4) = "日期"

newws.Range("A1:A65536").ColumnWidth = 50

newws.Range("B1:B65536").ColumnWidth = 50

newws.Range("C1:C65536").ColumnWidth = 50

newws.Range("D1:D65536").ColumnWidth = 50



newws.Range("A1:A65536").HorizontalAlignment = Excel.xlCenter

newws.Range("B1:B65536").HorizontalAlignment = Excel.xlCenter

newws.Range("C1:C65536").HorizontalAlignment = Excel.xlCenter

newws.Range("D1").HorizontalAlignment = Excel.xlCenter

newws.Range("D2:D65536").HorizontalAlignment = Excel.xlLeft


newws.Range("A1:A65536").NumberFormatLocal = "@"

newws.Range("B1:B65536").NumberFormatLocal = "@"

newws.Range("C1:C65536").NumberFormatLocal = "@"

newws.Range("D1:D65536").NumberFormatLocal = "@"

Dim n As Integer

Dim m As Integer

n = 2

m = 2


Do


datestr = ws.Cells(n, 10)


If datestr = inputdate Then

phone = ws.Cells(n, 26)

money = ws.Cells(n, 8)

goods = ws.Cells(n, 7)


newws.Cells(m, 1) = phone


money = Format$(money, "Standard")


newws.Cells(m, 2) = money

newws.Cells(m, 3) = goods

newws.Cells(m, 4) = datestr

m = m + 1

End If


n = n + 1



Loop Until n = ws.UsedRange.Rows.Count + 1


End Sub