英文:
VBA Copy Region & Insert X Rows Based on Region
问题
以下是翻译好的部分：
我想复制一部分数据，并根据当前区域插入X行，然后将其值仅粘贴到新创建的行中，以推动下面的多个子表格。
我目前的做法是尝试复制单元格数据，但除了标题行之外，它仍然这样做。
一组工作表，这个复制插入粘贴应该起作用。但是，在某些工作表上，代码的行为与预期不符，因为数据重复粘贴到列的末尾；因此，整行数据被重复粘贴，但不会发生在所有工作表上。
它基本上有效，除了上述错误，因为复制的区域是公式，数据不能正确粘贴，我只想粘贴值。
Dim lrow, lcol, brow, row, iRange, i As Long
Dim arrWs As Variant
Dim dRange, fcell, cRange As Range
Set wb = Workbooks.Open(Path & eStrFile)
Const first_cell As String = "A2"
arrWs = Array(7, 8, 9, 12, 13, 15)
For i = LBound(arrWs) To UBound(arrWs)
With wb.Sheets(arrWs(i))
Set fcell = .Range(first_cell)
Set cRange = fcell.CurrentRegion.Resize(.Rows.Count - fcell.row)
iRange = fcell.CurrentRegion.Rows.Count + cRange.row + 1
cRange.CurrentRegion.Copy
.Rows(iRange).Insert Shift:=xlDown
Application.CutCopyMode = False
End With
Next i
英文:
I'm looking to copy a section of data and insert X amount of rows based on the current region and paste with it's values only into the newly created rows that push down multiple sub tables below this data.
What I have currently is trying to copy the cells data except the header row but it still does so.
An array of worksheets, this copy insert paste should work on. However, on certain sheets the code isn't doing as expected since the data pastes repeatedly to the end of columns; so it's a whole row of data pasted across but does not happen on all sheets.
It works mostly expect the said errors and because the copied region are formulas, the data doesn't paste itself correctly, I only want the values being pasted.
Dim lrow, lcol, brow, row, iRange, i As Long
Dim arrWs As Variant
Dim dRange, fcell, cRange As Range
Set wb = Workbooks.Open(Path & eStrFile)
Const first_cell As String = "A2"
arrWs = Array(7, 8, 9, 12, 13, 15)
For i = LBound(arrWs) To UBound(arrWs)
With wb.Sheets(arrWs(i))
Set fcell = .Range(first_cell)
Set cRange = fcell.CurrentRegion.Resize(.Rows.Count - fcell.row)
iRange = fcell.CurrentRegion.Rows.Count + cRange.row + 1
cRange.CurrentRegion.Copy
.Rows(iRange).Insert Shift:=xlDown
Application.CutCopyMode = False
End With
Next i
答案1
得分: 2
以下是您的代码的翻译部分：
Dim arrWs As Variant, wb As Workbook, i As Long, rng As Range
'...
'...
Set wb = Workbooks.Open(Path & eStrFile)
arrWs = Array(7, 8, 9, 12, 13, 15)
For i = LBound(arrWs) To UBound(arrWs)
Set rng = wb.Sheets(arrWs(i)).Range("A1").CurrentRegion '包括标题
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1) '排除标题并调整大小
rng.Offset(rng.Rows.Count).EntireRow.Insert shift:=xlShiftDown '在下方插入行
rng.Offset(rng.Rows.Count).Value = rng.Value '仅复制值
Next i
如果您需要进一步的帮助，请随时告诉我。
英文:
Not clear on exactly what you're trying to do, but this should be close:
Dim arrWs As Variant, wb As Workbook, i As Long, rng As Range
'...
'...
Set wb = Workbooks.Open(Path & eStrFile)
arrWs = Array(7, 8, 9, 12, 13, 15)
For i = LBound(arrWs) To UBound(arrWs)
Set rng = wb.Sheets(arrWs(i)).Range("A1").CurrentRegion 'includes headers
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1) 'exclude headers and resize
rng.Offset(rng.Rows.Count).EntireRow.Insert shift:=xlShiftDown 'insert rows below
rng.Offset(rng.Rows.Count).Value = rng.Value 'copy values only
Next i
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论