bananas
08-18-2016, 09:42 AM
Hi,
I want to do this:
1 Open every workbook in the folder C:\Station\Div\ABC\Test\Test3\.
2 Do some c&p (see code) before copy R19 (in all workbooks in Test3 folder) to "C:\Station\Div\ABC\Test\vikt.xlsm", sheet1, column W.
So far everything in code works fine but then I want to:
3 Put the filename of every wb into the corresponding row in column X.
I have tested alot but can't get anything to work. (I'm new to VBA)
Sub CopyAllWBinFolder()
Dim wbk As Workbook
Dim wbdest As Workbook
Dim FileName As String
Dim Path As String
Path = "C:\Station\Div\ABC\Test\Test3\"
FileName = Dir(Path & "*.xlsm")
Set wbdest = Workbooks.Open("C:\Station\Div\ABC\Test\vikt.xlsm")
Do While Len(FileName) > 0
Application.ScreenUpdating = False
Set wbk = Workbooks.Open(Path & FileName, UpdateLinks:=0)
' Code
Workbooks("vikt.xlsm").Worksheets("Sheet1").Range("A2:R2").Copy
Range("B39:S39").PasteSpecial Paste:=xlPasteValues
Range("R19").Copy
Workbooks("vikt.xlsm").Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues
'Here I need to paste Workbook name in column X
wbk.Close SaveChanges:=False
FileName = Dir
Loop
Application.ScreenUpdating = True
End Sub
Any help is much appreciated, Thanks
I want to do this:
1 Open every workbook in the folder C:\Station\Div\ABC\Test\Test3\.
2 Do some c&p (see code) before copy R19 (in all workbooks in Test3 folder) to "C:\Station\Div\ABC\Test\vikt.xlsm", sheet1, column W.
So far everything in code works fine but then I want to:
3 Put the filename of every wb into the corresponding row in column X.
I have tested alot but can't get anything to work. (I'm new to VBA)
Sub CopyAllWBinFolder()
Dim wbk As Workbook
Dim wbdest As Workbook
Dim FileName As String
Dim Path As String
Path = "C:\Station\Div\ABC\Test\Test3\"
FileName = Dir(Path & "*.xlsm")
Set wbdest = Workbooks.Open("C:\Station\Div\ABC\Test\vikt.xlsm")
Do While Len(FileName) > 0
Application.ScreenUpdating = False
Set wbk = Workbooks.Open(Path & FileName, UpdateLinks:=0)
' Code
Workbooks("vikt.xlsm").Worksheets("Sheet1").Range("A2:R2").Copy
Range("B39:S39").PasteSpecial Paste:=xlPasteValues
Range("R19").Copy
Workbooks("vikt.xlsm").Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues
'Here I need to paste Workbook name in column X
wbk.Close SaveChanges:=False
FileName = Dir
Loop
Application.ScreenUpdating = True
End Sub
Any help is much appreciated, Thanks