Sub CopyDataToDataSheet()
Dim dataSheet As Worksheet
Dim inputSheet As Worksheet
Dim calculationSheet As Worksheet
Dim lastRow As Long
Dim yearMonthValue As Variant
Dim confirmation As Integer
Dim yearMonthColumn As Range
Dim sourceSheetColumn As Range
Dim dataRange As Range
Dim sourceSheetNames As Variant
Dim dataLastRow As Long`
' Set the data sheet
Set dataSheet = ThisWorkbook.Worksheets("Data Archive")
' Unfilter the data sheet
If dataSheet.AutoFilterMode Then
dataSheet.AutoFilterMode = False
End If
' Set the calculation sheet
Set calculationSheet = ThisWorkbook.Worksheets("Calculation")
' Find the column index of "SourceSheet" in the data sheet
Set sourceSheetColumn = dataSheet.Rows(1).Find("SourceSheet", LookIn:=xlValues, LookAt:=xlWhole)
' Loop through the input sheets
sourceSheetNames = Array("sheet1", "sheet2", "sheet3", "sheet4")
For Each inputSheet In ThisWorkbook.Worksheets(sourceSheetNames)
' Find the last row in the data sheet
lastRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row
' Copy the data from the input sheet to the data sheet
Set dataRange = inputSheet.UsedRange.Offset(1)
dataRange.Copy dataSheet.Cells(lastRow + 1, "A")
' Get the value from cell F1 of the Calculation sheet
yearMonthValue = calculationSheet.Range("F1").Value
' Check if "SourceSheet" column exists
If Not sourceSheetColumn Is Nothing Then
' Find the last row of imported data in column A
dataLastRow = lastRow + dataRange.Rows.Count
' Assign the source sheet name to the "SourceSheet" column in the data sheet for each row
dataSheet.Range(dataSheet.Cells(lastRow + 1, sourceSheetColumn.Column), dataSheet.Cells(dataLastRow, sourceSheetColumn.Column)).Value = inputSheet.Name
' Clear the remaining cells in the "SourceSheet" column below the imported data
dataSheet.Range(dataSheet.Cells(dataLastRow + 1, sourceSheetColumn.Column), dataSheet.Cells(dataSheet.Rows.Count, sourceSheetColumn.Column)).ClearContents
End If
' Find the column index of "YearMonth" in the data sheet
Set yearMonthColumn = dataSheet.Rows(1).Find("YearMonth", LookIn:=xlValues, LookAt:=xlWhole)
' Check if "YearMonth" column exists
If Not yearMonthColumn Is Nothing Then
' Assign the yearMonthValue to the "YearMonth" column in the data sheet for each row
dataSheet.Range(dataSheet.Cells(lastRow + 1, yearMonthColumn.Column), dataSheet.Cells(dataLastRow, yearMonthColumn.Column)).Value = yearMonthValue
' Clear the remaining cells in the "YearMonth" column below the imported data
dataSheet.Range(dataSheet.Cells(dataLastRow + 1, yearMonthColumn.Column), dataSheet.Cells(dataSheet.Rows.Count, yearMonthColumn.Column)).ClearContents
End If
' Delete the data from the input sheet
' dataRange.ClearContents
Next inputSheet
' Display success message
MsgBox "Data imported successfully."
End Sub`
</details>
# 答案1
**得分**: 0
这是您提供的代码的翻译部分：
```vba
不清楚为什么你的结果差了数百行。您的数据可能存在一些奇怪的问题。有时在Excel中，当使用VBA中的“UsedRange”时，会捕获到不可见的数据或格式。因此，您可以尝试使用“ReallyUsedRange”函数，而不是`inputSheet.UsedRange`。例如，请参考这里：[getting-the-actual-usedrange](https://stackoverflow.com/questions/7423022/getting-the-actual-usedrange)
我在下面放置了代码的新版本。
关于ChatGPT的代码的一些想法：
- 验证应该放在代码的早期，而不是在循环内部。因此，如果无法解析列索引，就不需要开始循环。
- 您需要始终让用户知道什么时候出现了问题（即，如果验证失败）。
- 另外，验证似乎有点武断 - 列经过验证，但未验证其他工作表是否存在，或者是否找到了正确的年份-日期值，或者输入数据是否具有正确的形状（列数）。也许所有这些都与ChatGPT的“指令”有关。
- 复制的数据的行计数根本不起作用。
- 它也没有正确处理空的输入工作表。
- 我没有看到清除数据的理由，因为根据定义，它进入了最后一行，下面没有数据。
- 如上所述，如果不小心使用“UsedRange”，它有点不可靠。
- 我们的工作似乎仍然安全，至少目前如此：）尽管如此，ChatGPT的发展令人印象深刻，所以继续关注ChatGPT的发展。
新代码：
Sub CopyDataTowsTarget()
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
Dim yearMonth As Variant
Dim i As Long
Dim j As Long
Dim r As Range
Dim s_col As Long
Dim y_col As Long
Dim arr
&#39;先决条件
&#39;名为DataArchive的工作表，具有A、B、C、D、SourceSheet、YearMonth列以及单元格A2:D10中的一些随机数据。
&#39;名为Calculation的工作表，单元格F1中有'2023-05'。
&#39;四个工作表sheet1、sheet2、sheet3、sheet4，其中单元格A2:D10中有随机数据（可能多或少几行）。
&#39; 设置数据工作表
Set wsTarget = ThisWorkbook.Worksheets(&quot;Data Archive&quot;)
&#39; 仅为了在调试时加快进度
&#39;wsTarget.Range(&quot;A11:J1000&quot;).Clear 
If wsTarget.AutoFilterMode Then
wsTarget.AutoFilterMode = False
End If
yearMonth = Worksheets(&quot;Calculation&quot;).Range(&quot;F1&quot;).Value
&#39; 获取MonthYear和SourceSheet列索引
Set r = wsTarget.Rows(1).Find(&quot;SourceSheet&quot;, LookIn:=xlValues, LookAt:=xlWhole)
If r Is Nothing Then
MsgBox &quot;未找到源工作表列！&quot;
Exit Sub
Else
s_col = r.Column
End If
Set r = wsTarget.Rows(1).Find(&quot;YearMonth&quot;, LookIn:=xlValues, LookAt:=xlWhole)
If r Is Nothing Then
MsgBox &quot;未找到年月列！&quot;
Exit Sub
Else
y_col = r.Column
End If
&#39; 从输入工作表复制数据到存档工作表
arr = Array(&quot;sheet1&quot;, &quot;sheet2&quot;, &quot;sheet3&quot;, &quot;sheet4&quot;)
For Each wsSource In Worksheets(arr)
i = wsTarget.Cells(wsTarget.Rows.Count, &quot;A&quot;).End(xlUp).Row + 1
Set r = wsSource.UsedRange.Offset(1)
If r.Rows.Count &gt; 1 Then
Set r = wsSource.UsedRange.Offset(1)
Set r = r.Resize(r.Rows.Count - 1)
r.Copy
wsTarget.Cells(i, &quot;A&quot;).PasteSpecial xlPasteValuesAndNumberFormats
wsTarget.Cells(i, s_col).Resize(r.Rows.Count).Value = wsSource.Name
wsTarget.Cells(i, y_col).Resize(r.Rows.Count).Value = yearMonth
&#39; dataRange.ClearContents
End If
Next wsSource
&#39; 显示成功消息
MsgBox &quot;成功导入数据。&quot;
End Sub