Vba 在列中查找文本字符串，复制到定义的范围循环

我在论坛上浏览了一下，没有找到我想要的东西

基本上，我有一些数据存储在一个目录中，我有一个主文件。代码将查看堆叠在列表中的文件名。当文件打开时，代码应该查找文件名。识别文件后（没有关于导入文件名.xls的线索），需要从第一行向下和第三列跨行复制数据，直到数据中断/完成。然后，代码需要引用母版图纸上的一个范围，在清除内容后，数据将粘贴到该范围。完成后，代码循环到下一个文件并重复

它们有五个名称/字符串

我显然是一个完全的新手，非常感谢任何帮助和指导

詹姆斯

---

这是您的代码，已格式化且没有注释掉的代码：

Sub import()
    Dim mydir As String, r As Range, fn As String, msg As String
    Dim LR As Long
    Dim x As Long
    Dim bottomC As Integer
    Dim c As Range
    'loop through files in Prism dir and import  reports named in list .
    mydir = "C:\desktop\”"
    For Each r In Range("F8", Range("F" & Rows.Count).End(xlUp))
        fn = Dir(mydir & r.Value)
        If fn = "" Then
            msg = msg & vbLf & r.Value
        Else
            For Each c In Sheets("DataToImport").Range("A8")
                If c.Value = "DataSet1" Then
                    Sheets("DataToImport ").Range("A8:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Copy
                    ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").ClearContents
                    ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").Paste
                   .Close False
            End With
        End If
    Next
    If Len(msg) Then
        MsgBox "Not found" & msg
    End If
End Sub

…这甚至不会开始，因为您有一个

结束于

，其中没有

结束于

，并且因为没有With block，

。Close False

无效

对于

..
.Range（“A8”）
中的每个c，
也没有意义，因为您正在一个单元格上循环，
Range（“A8”）
。使用
Set c
将
c
明确设置为范围

此外，如果在excel中复制某些内容，然后更改任何其他单元格的值，则会取消复制，因此这三条语句的顺序错误：

.Copy
.ClearContents
.Paste

最后，您不能执行范围（x）.粘贴，您只能执行
Range.pasteAll
，（或者您可以在选定范围内执行
Sheet.Paste
）

经过所有这些更正，您的代码如下所示：

//编辑代码以与下面的注释相对应//

Sub import()
    Dim mydir As String, r As Range, fn As String, msg As String
    Dim LR As Long
    Dim x As Long
    Dim bottomC As Integer
    Dim c As Range
    'loop through files in Prism dir and import  reports named in list .
    mydir = "C:\desktop\"
    For Each r In Range("F8", Range("F" & Rows.Count).End(xlUp))
        fn = Dir(mydir & r.Value)
        If fn = "" Then
            msg = msg & vbLf & r.Value
        Else
            Set c = Sheets("DataToImport").Range("A8")
            If c.Value = "DataSet1" Then
                ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").ClearContents
                Sheets("DataToImport ").Range("A8:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Copy
                ThisWorkbook.Sheets("Mapping").Range("AC4").PasteSpecial xlPasteAll
            ElseIf c.Value = "DataSet2" Then
                ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").ClearContents
                Sheets("DataToImport ").Range("A8:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Copy
                ThisWorkbook.Sheets("Mapping").Range("AC4").PasteSpecial xlPasteAll
               '.Close False '-Put this somewhere else
            End If
        End If
    Next
    If Len(msg) Then
        MsgBox "Not found" & msg
    End If
End Sub

另一件事——它的bat实践是提供一个包含多个单元格的范围作为粘贴目标，因为例如，如果复制
A1:A2
，然后粘贴到
B1:B4
，它将粘贴两次
A1:A2
，这可能不是您想要的

抱歉，如果这是屈尊，那不是我的本意。此外，我不想在您不尝试解决此问题的情况下提供完整的解决方案

希望这能让你走上正轨
 想要格式化你的代码吗？一点也不，非常感谢-感谢你的建议。。这一切都是有道理的。最后一件事。是否需要循环中的循环？找到“DataSet1”并将数据复制到目标表中“DataSet1”的过去范围后，代码将需要识别其他四个字符串“DataSet2”、“DataSet3”等，所有字符串都具有各自的范围。该如何处理？可以重复if…end if块。如果c.value=“Dataset1”elseif c.value=“Dataset2”end if
等，您可以执行
操作。我已经编辑了上面的答案来说明这一点
Sub import()
    Dim mydir As String, r As Range, fn As String, msg As String
    Dim LR As Long
    Dim x As Long
    Dim bottomC As Integer
    Dim c As Range
    'loop through files in Prism dir and import  reports named in list .
    mydir = "C:\desktop\"
    For Each r In Range("F8", Range("F" & Rows.Count).End(xlUp))
        fn = Dir(mydir & r.Value)
        If fn = "" Then
            msg = msg & vbLf & r.Value
        Else
            Set c = Sheets("DataToImport").Range("A8")
            If c.Value = "DataSet1" Then
                ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").ClearContents
                Sheets("DataToImport ").Range("A8:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Copy
                ThisWorkbook.Sheets("Mapping").Range("AC4").PasteSpecial xlPasteAll
            ElseIf c.Value = "DataSet2" Then
                ThisWorkbook.Sheets("Mapping").Range("AC4:AE5000").ClearContents
                Sheets("DataToImport ").Range("A8:C" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Copy
                ThisWorkbook.Sheets("Mapping").Range("AC4").PasteSpecial xlPasteAll
               '.Close False '-Put this somewhere else
            End If
        End If
    Next
    If Len(msg) Then
        MsgBox "Not found" & msg
    End If
End Sub