|
Sub MergeWorksheets()
Dim folderPath As String
Sheets("mo").Select
k0 = Cells(10, 3).Value
k1 = Cells(11, 3).Value
ff = Cells(9, 6).Value
io = Cells(9, 7).Value
sht = Cells(9, 5).Value
pt1 = Cells(9, 4).Value
s_sht = Cells(8, 5).Value
folderPath = Cells(8, 4).Value '源文件夹
pt2 = Cells(8, 4).Value '源文件夹
okfl = ff
pt = pt1 '定义操作目录
ChDir pt
Call OpenWB '=================判断文件是否并,如存在并打开
Windows(okfl).Activate '选择核算成本表
Sheets(sht).Select
For k = 1 To 65000
If Cells(k, 1) = "" Then GoTo loop10
Next
loop10:
Range(Cells(2, 1), Cells(k, 30)).Select
Selection.ClearContents
Dim fileName As String
fileName = Dir(folderPath & "\*.xls*")
ChDrive "e:"
ChDrive folderPath
pt = folderPath
CurDir ("e:\")
MsgBox pt
ChDir pt
okfl = fileName
Call OpenWB '=================判断文件是否并,如存在并打开
Windows(fileName).Activate '选择核算成本表
Dim combinedWorkbook As Workbook
Set combinedWorkbook = Workbooks.Open(ff)
Dim combinedSheet As Worksheet
Set combinedSheet = combinedWorkbook.Sheets(sht)
'定义数组用于存储合并后的数据
Dim dataArray() As Variant
ReDim dataArray(1 To 65000, 1 To k1)
Do While fileName <> ""
Dim sourceWorkbook As Workbook
Set sourceWorkbook = Workbooks.Open(folderPath & "\" & fileName)
Dim sourceSheet As Worksheet
Set sourceSheet = sourceWorkbook.Sheets(s_sht)
Dim lastRow As Long
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
'将源工作表数据读入数组
Dim sourceData() As Variant
sourceData = sourceSheet.Range(sourceSheet.Cells(1, 1), sourceSheet.Cells(lastRow, k1)).Value
'将源数据添加到合并数组
Dim i As Long
For i = 1 To lastRow
dataArray(i + UBound(dataArray, 1) - lastRow, 1) = sourceData(i, 1)
For j = k0 To k1
dataArray(i + UBound(dataArray, 1) - lastRow, j) = sourceData(i, j)
Next j
Next i
sourceWorkbook.Close False
fileName = Dir
Loop
'将合并后的数据一次性写入目标工作表
combinedSheet.Range(combinedSheet.Cells(1, 1), combinedSheet.Cells(UBound(dataArray, 1), UBound(dataArray, 2))).Value = dataArray
combinedWorkbook.Save
'combinedWorkbook.Close
End Sub
为什么 第二 chdir pt 找不到路径, pt 所指的路径是对的
|
|