Vba 改进用于复制/粘贴的代码

我需要减少我在哪里写synatx的代码，以便复制和粘贴行值

Private Sub btn_upload_Click()
'Frm_Mainform.Show
'MsgBox ("Process Complete - Please Check File in Output Folder")
Const FOLDER As String = "C:\SBI_Files\"

On Error GoTo ErrorHandler

Dim i As Integer
i = 18

Dim fileName As String

fileName = Dir(FOLDER, vbDirectory)

  Do While Len(fileName) > 0

If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
    i = i + 1

    Dim currentWkbk As Excel.Workbook
     Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
     Cells(i, 1) = fileName
     Cells(i + 1, 2) = "Equity"
     Cells(i + 2, 2) = "Forex NOOP"
     Cells(i + 3, 2) = "Fixed   Income Securities  ( including CP, CD, G Sec)"
     Cells(i + 4, 2) = "Total"
     Cells(i, 2) = "Details"
     Cells(i, 3) = "Limit"
     Cells(i, 4) = "Min Var"
     Cells(i, 5) = "Max Var"
     Cells(i, 6) = "No. of Breaches"
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G8:G8").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H8:H8").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I8:I8").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J8:J8").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G9:G9").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H9:H9").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I9:I9").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J9:J9").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G10:G10").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H10:H10").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I10:I10").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J10:J10").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G11:G11").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H11:H11").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I11:I11").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J11:J11").Value
     i = i + 1
     currentWkbk.Close
End If
fileName = Dir
Loop

ProgramExit:
   Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

---

您可以将所有的

单元格

行替换为以下4行

更新：添加了应对方式行

---

无需指定

“G8:G8”

。一个简单的

.Range（“G8”）.Value

就可以了。此外，我认为这应该是在

For

循环中，而不是在

Do While

循环中。我需要在粘贴值时应用相同的颜色（从复制数据的位置开始，颜色必须相同），并且需要为所有数据应用边框，然后如何修改现有代码。嗨，Brettdj，值没有被复制。只有列名称和行名称被复制。请帮助。Hi-Brettd J代码正在工作，非常感谢。请告诉我如何格式化相同的颜色，同时为下面的单元格粘贴相同的值。我需要为行和列标题应用特定的颜色。我添加了。colur（36）每行代码后的单元格出现对象错误（i+1,2）。调整大小（4,1）=应用程序。转置（数组（“股票”、“外汇NOOP”、“固定收益证券（包括CP、CD、G Sec）”，“总计”））单元格（i,2）。调整大小（1,5）=数组（“详细信息”、“限额”、“最小风险”、“最大风险”，“违约次数

 'other code
 Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
 Cells(i, 1) = fileName
 Cells(i + 1, 2).Resize(4, 1) = Application.Transpose(Array("Equity", "Forex NOOP", "Fixed   Income Securities  ( including CP, CD, G Sec)", "Total"))
 Cells(i, 2).Resize(1, 5) = Array("Details", "Limit", "Min Var", "Max Var", "No. of Breaches")
 Cells(i + 1, 3).Resize(4, 4) = currentWkbk.Sheets("VaR").Range("G8:J11").Value
 currentWkbk.Sheets("VaR").Range("G8:J11").Copy Cells(i + 1, 3)
 currentWkbk.Close