将范围复制到另一个 sheet
Copy range to another sheet
我是 VBA 的超级新手,我正在尝试将范围从关闭的 Excel 文件复制到活动工作簿而不覆盖当前粘贴的范围。
这是在 Excel 2016 年。
Sub GetDataFromWbs()
Dim wb As Workbook
Dim ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.Getfolder("C:\Path")
Dim lastrow As Long
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
ThisWorkbook.Activate
Worksheets("Sheet1").Range("A1:D12").Formula = wb.Worksheets("Sheet1").Range("a1:c3").Formula
'here is where I would like to add +1 so my loop isn't overridden
Next 'ws
wb.Close
End If
Next 'wbFile
End Sub
我想您可能正在寻找类似的东西。我在代码中添加了注释以帮助解释它。
Sub tgr()
Dim wbDest As Workbook
Dim wsDest As Worksheet
Dim rCopy As Range
Dim sFolder As String
Dim sFile As String
Dim lRow As Long
Set wbDest = ThisWorkbook 'The workbook where information will be copied into
Set wsDest = wbDest.Worksheets("Sheet1") 'The worksheet where information will be copied into
sFolder = "C:\Test\" 'The folder path containing the xlsx files to copy from
lRow = 1 'The starting row where information will be copied into
'Adjust the folder path to ensure it ends with \
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
'Get the first .xlsx file in the folder path
sFile = Dir(sFolder & "*.xlsx")
'Begin loop through each file in the folder
Do While Len(sFile) > 0
'Open the current workbook in the folder
With Workbooks.Open(sFolder & sFile)
'Copy over the formulas from A1:C3 from only the first worksheet into the destination worksheet
Set rCopy = .Sheets(1).Range("A1:C3")
wsDest.Cells(lRow, "A").Resize(rCopy.Rows.Count, rCopy.Columns.Count).Formula = rCopy.Formula
'Advance the destination row by the number of rows being copied over
lRow = lRow + rCopy.Rows.Count
.Close False 'Close the workbook that was opened from the folder without saving changes
End With
sFile = Dir 'Advance to the next file
Loop
End Sub
我是 VBA 的超级新手,我正在尝试将范围从关闭的 Excel 文件复制到活动工作簿而不覆盖当前粘贴的范围。
这是在 Excel 2016 年。
Sub GetDataFromWbs()
Dim wb As Workbook
Dim ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.Getfolder("C:\Path")
Dim lastrow As Long
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbFile.Path)
For Each ws In wb.Sheets
ThisWorkbook.Activate
Worksheets("Sheet1").Range("A1:D12").Formula = wb.Worksheets("Sheet1").Range("a1:c3").Formula
'here is where I would like to add +1 so my loop isn't overridden
Next 'ws
wb.Close
End If
Next 'wbFile
End Sub
我想您可能正在寻找类似的东西。我在代码中添加了注释以帮助解释它。
Sub tgr()
Dim wbDest As Workbook
Dim wsDest As Worksheet
Dim rCopy As Range
Dim sFolder As String
Dim sFile As String
Dim lRow As Long
Set wbDest = ThisWorkbook 'The workbook where information will be copied into
Set wsDest = wbDest.Worksheets("Sheet1") 'The worksheet where information will be copied into
sFolder = "C:\Test\" 'The folder path containing the xlsx files to copy from
lRow = 1 'The starting row where information will be copied into
'Adjust the folder path to ensure it ends with \
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
'Get the first .xlsx file in the folder path
sFile = Dir(sFolder & "*.xlsx")
'Begin loop through each file in the folder
Do While Len(sFile) > 0
'Open the current workbook in the folder
With Workbooks.Open(sFolder & sFile)
'Copy over the formulas from A1:C3 from only the first worksheet into the destination worksheet
Set rCopy = .Sheets(1).Range("A1:C3")
wsDest.Cells(lRow, "A").Resize(rCopy.Rows.Count, rCopy.Columns.Count).Formula = rCopy.Formula
'Advance the destination row by the number of rows being copied over
lRow = lRow + rCopy.Rows.Count
.Close False 'Close the workbook that was opened from the folder without saving changes
End With
sFile = Dir 'Advance to the next file
Loop
End Sub