Question

如何用vba实现选择打开一个excel并复制里面的数据

Answer 1

新建一个工作簿，命名为“当前宏”然后在sheet1里面第一行输入标题行（你先把你要打开的表格的第一行复制过来就可以了，然后关掉），视图->宏->录制宏，然后随便点一下，然后再点击停止录制宏，然后，视图->宏->查看宏，进入刚刚建立的宏，把下面的宏复制进去全部替换掉原来的，然后运行就可以了，记得把“当前宏”这个EXCEL表放到你想打开的所有EXCEL表当前目录下哦，然后会自动打开所有的EXCEL，并且自动复制第二行开始的所有内容到“当前宏”的第一张工作簿中

Sub 打开excel表格()
Dim myPath$, myFile$, AK As Workbook
Dim k
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
workdir = ActiveWorkbook.Path
k = 0

myFile = Dir(workdir & "\*.xls") '只要是2003版的EXCEL表格都会自动打开
Do While myFile <> "" '当指定路径中有文件时进行循环
Set AK = Workbooks.Open(workdir & myFile) '打开符合要求的文件
Call Macro1(myFile) '此处调用下面的那个子过程，就是复制表格里头的东西
myFile = Dir '找寻下一个*.xls文件
Loop
Windows("当前宏.xls").Activate
ActiveWorkbook.Save
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
End Sub

Sub Macro1(file As String)

Application.StatusBar = "正复制在EXCEL文件"& file &"里的内容......"
Windows(file).Activate
sheets(1).select
h=range("a63000").end(xlup).row
l=range("a1").end(xltoright).column
range(cells(2,1),cells(h,l)).select
selection.copy
Windows("当前宏.xls").Activate
h=range("a63000").end(xlup).row
sheets(1).cells(h+1,1).select
ActiveSheet.Paste
Windows(file).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

End Sub

Answer 2

假设打开的文件是D盘123文件夹中的1.xls文件，并将sheet1中的内容，复制到当前Excel文件的sheet1工作表中，以下是代码及其解释：

Sub main()
Workbooks.Open Filename:="D:\123\1.xls" '通过Open的方法打开Excel文件，Filename即打开的文件名，必须包含完整的路径和完整的工作名
ActiveWorkbook.Sheets(1).Cells.Copy ThisWorkbook.Sheets(1).Cells '这里包含了复制和粘贴，Copy前面的是要复制的对象，而后面是要粘贴的目的区域，Cells是表示对整个工作表的内容进行复制
End Sub

Answer 3

Sub Macro1()
Workbooks.Open Filename:="E:\111\111.xls"
Range("A4:D43").Copy
Windows("Book1").SelectedSheets("sheet1").Paste
End Sub

Answer 4

将下面的代码作相应的修改：
Dim wkbk As Workbook '定义一个工作薄
Dim myFileName As String, x As Integer, rw As Integer '定义要读取的文件路径
'rw = ThisWorkbook.Sheets("设计书记录").UsedRange.Rows.Count + 1
rw = ThisWorkbook.Sheets("设计书记录").[W65536].End(xlUp).Row + 1
myFileName = Application.GetOpenFilename("Excel2003 (*.xls), *.xls") '浏览本地CSV文件

If myFileName = "False" Then '如果按取消那么弹出对话框

MsgBox "请选择文件!", vbInformation, "取消"

Else

Set wkbk = Workbooks.Open(myFileName) '先打开要复制的文件
On Error Resume Next
If Sheets("设计书记录").Range("B2").Text <> "设计单位" Then

wkbk.Close False

MsgBox "文件错误，请重新选择!", vbInformation, "取消"

Else
Dim d As Integer
d = wkbk.Sheets("设计书记录").[W65536].End(xlUp).Row

With wkbk.Sheets("设计书记录")
.Range("AO4:AO" & d) = "未发证"
' x = .UsedRange.Rows.Count
x = .[W65536].End(xlUp).Row

.Range("A4:bb" & x).Copy Destination:=ThisWorkbook.Sheets("设计书记录").Range("A" & rw)

End With
wkbk.Close False '关闭打开的文件
End If
End If

追问

请问如何用vba实现选择打开一个EXCE文件，并把这个该文件的Sheet1中的A1：Q30复制到当前工作表中，然后关