[英]Combine multiple workbooks to one workbook
I need to combine multiple workbook to one workbook.我需要将多个工作簿合并为一个工作簿。
Source workbooks have unique sheet name = "job"源工作簿具有唯一的工作表名称 = "job"
Destination workbook have multiple sheets name目标工作簿有多个工作表名称
The Below code have 2 issues,下面的代码有两个问题,
For loop not work For循环不起作用
pasted data in Destination workbook create a new sheet.目标工作簿中粘贴的数据创建一个新工作表。 But i need to paste the data to existing sheet.
但我需要将数据粘贴到现有工作表中。
Sub combine() 'destination worksheets Dim Ar As Worksheet Dim nr As Worksheet Set Ar = ThisWorkbook.Sheets("sheetAr") Set nr = ThisWorkbook.Sheets("Sheetnr") 'Source workbooks Dim FolderPath As String Dim Filename As String Application.ScreenUpdating = False FolderPath = Environ("userprofile" & "\\Desktop\\Copy") Filename = Dir(FolderPath & "*.xlsx*") Do While Filename <> "" Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True Dim ws As Worksheet Dim AW As Workbook Set AW = ActiveWorkbook Set ws= ActiveWorkbook.Sheets("Job") For Each AW In ws AW.Activate Cells.ShownAll ws.Copy Ar Next AW Workbooks(Filename).Close savechanges = True Filename = Dir() Loop Application.ScreenUpdating = True End Sub
FolderPath = Environ("userprofile" & "\\Desktop\\Copy")
should be FolderPath = Environ("userprofile") & "\\Desktop\\Copy\\"
. FolderPath = Environ("userprofile" & "\\Desktop\\Copy")
应该是FolderPath = Environ("userprofile") & "\\Desktop\\Copy\\"
。 For Each AW In ws
makes no sense since AW
is a workbook and ws
a worksheet. For Each AW In ws
没有意义,因为AW
是工作簿而ws
是工作表。 You probably meant For Each ws in AW
but there is no need to loop if only Job
sheet is the source.您可能指的是
For Each ws in AW
但如果只有Job
sheet 是源,则无需循环。 Workbooks(Filename).Close savechanges = True
is missing :
but since the workbook was opened read-only there are no change to save so use .Close savechanges := False
. Workbooks(Filename).Close savechanges = True
丢失:
但由于工作簿以只读方式打开,因此没有任何更改可保存,因此请使用.Close savechanges := False
。
Option Explicit
Sub combine()
Dim wb As Workbook, rng As Range
Dim wsAr As Worksheet, wsSrc As Worksheet
Dim FolderPath As String, Filename As String
Dim iTargetRow As Long, c As Long, n As Long
FolderPath = Environ("userprofile") & "\Desktop\Copy\"
Filename = Dir(FolderPath & "*.xlsx*")
' destination worksheet
Set wsAr = ThisWorkbook.Sheets("sheetAr")
iTargetRow = wsAr.UsedRange.Row + wsAr.UsedRange.Rows.Count
Application.ScreenUpdating = False
Do While Filename <> ""
Set wb = Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
Set wsSrc = wb.Sheets("Job")
Set rng = wsSrc.UsedRange
rng.Copy wsAr.Cells(iTargetRow, rng.Column)
iTargetRow = iTargetRow + rng.Rows.Count
wb.Close savechanges:=False ' opened read only
Filename = Dir()
n = n + 1
Loop
Application.ScreenUpdating = True
MsgBox n & " workbooks scanned", vbInformation
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.