spitfire1956
New Member
- Joined
- Nov 3, 2009
- Messages
- 6
I have been adapting some forum code to open all the files in a folder and copy cells C6 to C40, then use paste special to paste their values into a new column in a target workbook. I can get the code below to work - this does just a paste of the cells (highlighted blue), but I cannot get the syntax right to do a paste special of the values from C6 to C40. Anyone able to assist?
Sub Process_Files()
Dim sourceBook As Workbook, writeBook As Workbook
Dim sFil As String
Dim sPath As String
Dim writeCol As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "T:\Users\APJ\Replacement Timesheet development"
.Show
If .SelectedItems.Count > 0 Then
sPath = .SelectedItems(1)
Else
MsgBox "Folder selection cancelled", vbInformation, Title:="Process Cancelled"
Exit Sub
End If
End With
ChDir sPath
sFil = Dir("*.xls")
Set writeBook = Workbooks.Add
writeCol = 1
Do While sFil <> ""
Set sourceBook = Workbooks.Open(sPath & "\" & sFil)
With writeBook.Sheets("Sheet1")
.Cells(1, writeCol) = sourceBook.Name ' write workbook name to row 1
sourceBook.Sheets("Time Recording").Range("C6:C40").Copy .Cells(2, writeCol) ' copy range to row 2
writeCol = writeCol + 1
End With
sourceBook.Close False
sFil = Dir
Loop
End Sub
Sub Process_Files()
Dim sourceBook As Workbook, writeBook As Workbook
Dim sFil As String
Dim sPath As String
Dim writeCol As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "T:\Users\APJ\Replacement Timesheet development"
.Show
If .SelectedItems.Count > 0 Then
sPath = .SelectedItems(1)
Else
MsgBox "Folder selection cancelled", vbInformation, Title:="Process Cancelled"
Exit Sub
End If
End With
ChDir sPath
sFil = Dir("*.xls")
Set writeBook = Workbooks.Add
writeCol = 1
Do While sFil <> ""
Set sourceBook = Workbooks.Open(sPath & "\" & sFil)
With writeBook.Sheets("Sheet1")
.Cells(1, writeCol) = sourceBook.Name ' write workbook name to row 1
sourceBook.Sheets("Time Recording").Range("C6:C40").Copy .Cells(2, writeCol) ' copy range to row 2
writeCol = writeCol + 1
End With
sourceBook.Close False
sFil = Dir
Loop
End Sub