Question

我是VBA的新手，正在通过几本书和该站点进行学习。我没有任何代码可以显示，因为它超出了我的技能范围。不便之处，敬请原谅。在此先感谢您的协助。 免责声明；其中一些步骤很容易，但是具体来说，步骤2和6会让我感到困惑。

书面要求：

您需要了解的内容： “ Agency”，“ COM”，“ HEN”，“ HTW”是表格＆在步骤2之后，新工作表将称为“ 9月”。

创建一个新工作表（位于其他所有工作表的末尾）
新表格的名称=“代理商”范围A1（这将是一个月）（新工作表在以下步骤中将被称为“ 9月”）
“ 9月” A1 =“站点”
“ 9月” B1 =“课程”
“ 9月” C1 =“指标”
“ COM”，“ HEN”和“ HTW”的范围A2：A20，B2：B20和C2：20列在步骤3-5的标题下。请注意，在为我提供代码帮助时，请不要将范围分组为A2：C20，因为这将有助于更有效地将它们分开，以便以后更好地适合我的图纸。

谢谢！

Answer 1

这应该可以解决问题。

Option Explicit

Sub DataCopy()

Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Agency")
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Sheets("COM")
Dim ws3 As Worksheet
Set ws3 = ThisWorkbook.Sheets("HEN")
Dim ws4 As Worksheet
Set ws4 = ThisWorkbook.Sheets("HTW")

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = ws1.Range("A1").Value

Dim ws5 As Worksheet
Set ws5 = ThisWorkbook.Sheets(ws1.Range("A1").Value)
Dim cntr As Integer
cntr = 0
Dim ROffset As Integer
ROffset = 0

ws5.Range("A1").Value = "Site"
ws5.Range("B1").Value = "Class"
ws5.Range("C1").Value = "Indicator"

Dim GetSheet As Worksheet

Do Until cntr = 3
    If cntr = 0 Then
        Set GetSheet = ThisWorkbook.Sheets("COM")
        ROffset = 0
    ElseIf cntr = 1 Then
        Set GetSheet = ThisWorkbook.Sheets("HEN")
        ROffset = 19
    ElseIf cntr = 2 Then
        Set GetSheet = ThisWorkbook.Sheets("HTW")
        ROffset = 38
    End If

    GetSheet.Range("A2:A20").Copy
    ws5.Range("A2:A20").Offset(ROffset, 0).PasteSpecial xlPasteValues
    GetSheet.Range("B2:B20").Copy
    ws5.Range("B2:B20").Offset(ROffset, 0).PasteSpecial xlPasteValues
    GetSheet.Range("C2:C20").Copy
    ws5.Range("C2:C20").Offset(ROffset, 0).PasteSpecial xlPasteValues
    cntr = cntr + 1
Loop

End Sub

请注意，这是实现目标的一种非常基本且静态的方法。如果您要从中获取数据或粘贴以进行更改的范围，则此代码将无法工作/产生不正确的结果。但是，它确实可以解决您提出的问题。

将数据从多张纸传送到一张纸

1 个答案: