我有500个包含数据的excel文件。我会将所有这些数据合并到一个文件中。
实现此目的的任务列表:
我已经完成了任务1-4但我需要帮助完成任务5,最后一点 - 将数据粘贴到现有数据下并使其动态化。我在代码中用######突出显示了这一点。
以下是我从其他人提出的问题代码:)
有关如何执行此操作的任何建议吗?
Sub LoopThroughFiles()
Dim MyObj As Object,
MySource As Object,
file As Variant
Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file
Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file
Dim LastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
'set to the current active workbook (the source book, the Master!)
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Sheet1")
Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\"
Fname = Dir(Folder)
While (Fname <> "")
Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
wbTarget.Activate
Range("b3:i102").Copy
wbThis.Activate
'################################
'NEED HELP HERE. I GET A ERROR HERE. NEEDS TO BE MORE DYNAMIC.
sht1.Range("b1:i100").PasteSpecial
Fname = Dir
'close the overnight's file
wbTarget.Close
Wend
End Sub
答案 0 :(得分:1)
我看到你已经为此添加了一个长变量,所以在粘贴之前对最后一行进行查找。此外,如果数据量不同,请粘贴到单个单元格中。
我修改了你的脚本如下。
Sub LoopThroughFiles()
Dim MyObj As Object,
MySource As Object,
file As Variant
Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file
Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file
Dim LastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
'set to the current active workbook (the source book, the Master!)
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Sheet1")
Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\"
Fname = Dir(Folder)
While (Fname <> "")
Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
wbTarget.Activate
Range("b3:i102").Copy
wbThis.Activate
'Just add this line:
lastrow = sht1.Range("b1").End(xlDown).Row + 1
'And alter this one as follows:
sht1.Range("B" & lastrow).PasteSpecial
Fname = Dir
'close the overnight's file
wbTarget.Close
Wend
End Sub
答案 1 :(得分:1)
如何将sht1.Range("b1:i102")
定义为变量而不是常量?
类似的东西:
Dim x As Long
Dim y As Long
x = 1
y = 1
Dim rng As Range
Set rng = Range("b"&x ,"i"&y)
然后使用:
sht1.rng
请记住在while语句的末尾添加x = x+100 and y = y +100
(因此它会在每个粘贴之间更新新值。)
答案 2 :(得分:1)
你为什么不放一个柜台?像这样:
http://local.tourplanner.com/2017/03
然后:
Dim counter As Long
counter = 1
答案 3 :(得分:1)
我认为使用变体比复制方法更有用。
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object
file As Variant
Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file
Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file
Dim LastRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim vDB As Variant
'set to the current active workbook (the source book, the Master!)
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Sheet1")
Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\"
Fname = Dir(Folder)
While (Fname <> "")
Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
vDB = wbTarget.Sheets(1).Range("b3:i102")
'################################
'NEED HELP HERE. I GET A ERROR HERE. NEEDS TO BE MORE DYNAMIC.
sht1.Range("b" & Rows.Count).End(xlUp)(2).Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
Fname = Dir
'close the overnight's file
wbTarget.Close
Wend
End Sub
答案 4 :(得分:-2)
您可以在下面的第5步中添加以下部分。我在循环中使用了偏移量和变量增量
Dim i as Long
Range("B1").Select // 'select the column where you want to paste value
ActiveCell.Offset(i, 0).Select //'place the offset counter with variable
sht1.Range("b1:i100").PasteSpecial
i=i+100 //'increment the offset with the number of data rows