复制数据并粘贴为值
Copy data and paste as values
我的代码当前将数据行从源工作簿复制到 Mastercopy excel。但是,我想将值粘贴为数字。知道如何修改下面的代码吗?
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"
Filepath = FolderPath & "*.csv"
Filename = Dir(Filepath)
Dim lastrow As Long, lastcolumn As Long
Dim erow
Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)
'Find the last non-blank cell in column A(1)
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lastcolumn = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(3, 1), Cells(lastrow, lastcolumn)).copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 10))
Filename = Dir
Loop
End Sub
好了,在 Set ws = ...
上编辑大师 sheet 的名字
Option Explicit
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
Dim wb As Workbook, ws As Worksheet, wbTemp As Workbook, wsTemp As Worksheet
'Define your master workbook and sheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("YourMasterSheetName")
FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"
Filepath = FolderPath & "*.csv"
Filename = Dir(Filepath)
Dim lastrow As Long, lastcolumn As Long
Dim erow As Long
Do While Filename <> ""
Set wbTemp = Workbooks.Open(FolderPath & Filename, UpdateLinks:=False, ReadOnly:=True)
Set wsTemp = wbTemp.Sheets(1) ' lets suppose it is always on the first sheet in the workbook
With wsTemp
'Find the last non-blank cell in column A(1)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lastcolumn = .Cells(3, Columns.Count).End(xlToLeft).Column
.Range(Cells(3, 1), Cells(lastrow, lastcolumn)).Copy
End With
'Find the last blank cell on your master sheet
erow = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
ws.Cells(erow, 2).PasteSpecial xlPasteValues
wbTemp.Close Savechanges:=False
Set wbTemp = Nothing
Set wsTemp = Nothing
Filename = Dir
Loop
End Sub
我的代码当前将数据行从源工作簿复制到 Mastercopy excel。但是,我想将值粘贴为数字。知道如何修改下面的代码吗?
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"
Filepath = FolderPath & "*.csv"
Filename = Dir(Filepath)
Dim lastrow As Long, lastcolumn As Long
Dim erow
Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)
'Find the last non-blank cell in column A(1)
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lastcolumn = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(3, 1), Cells(lastrow, lastcolumn)).copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 10))
Filename = Dir
Loop
End Sub
好了,在 Set ws = ...
Option Explicit
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
Dim wb As Workbook, ws As Worksheet, wbTemp As Workbook, wsTemp As Worksheet
'Define your master workbook and sheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("YourMasterSheetName")
FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"
Filepath = FolderPath & "*.csv"
Filename = Dir(Filepath)
Dim lastrow As Long, lastcolumn As Long
Dim erow As Long
Do While Filename <> ""
Set wbTemp = Workbooks.Open(FolderPath & Filename, UpdateLinks:=False, ReadOnly:=True)
Set wsTemp = wbTemp.Sheets(1) ' lets suppose it is always on the first sheet in the workbook
With wsTemp
'Find the last non-blank cell in column A(1)
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lastcolumn = .Cells(3, Columns.Count).End(xlToLeft).Column
.Range(Cells(3, 1), Cells(lastrow, lastcolumn)).Copy
End With
'Find the last blank cell on your master sheet
erow = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
ws.Cells(erow, 2).PasteSpecial xlPasteValues
wbTemp.Close Savechanges:=False
Set wbTemp = Nothing
Set wsTemp = Nothing
Filename = Dir
Loop
End Sub