Excel 将特定列从一个文件复制到另一个文件

我有一些代码可以将数据从一个文件导入另一个文件

我正在寻找的变化是只引入特定的列，例如A、B和F列

我认为这与代码有关

Sheets("Data").Columns(1).Copy Destination:=Sheets("Data").Columns(2)

主要代码：

Sub ImportData()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Set PasteStart = [Data!A1]

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.csv (*.csv),")

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    For Each Sheet In wb2.Sheets
        With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet

End If

    wb2.Close

End Sub

编辑：根据以下答案更新：

Sub ImportData()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Set PasteStart = [Data!A1]

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.csv (*.csv),")

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    wb2.Worksheets("Sheet1").Range("A:A").Copy wb1.Worksheets("Sheet1").Range("A:A")

End If

    wb2.Close

End Sub

---

不能轻易地在评论中转述这一点

尝试更改循环，如下所示：

For Each Sheet In wb2.Sheets
    With Sheet
        Intersect(.UsedRange, .Range("A:A,B:B,F:F")).Copy PasteStart
        Set PasteStart = Sheets("Data").Range("A" & Rows.Count).End(xlUp)(2)
    End With
Next Sheet

---

每列中的数据行数是否相同？如果没有，您需要考虑到这一点。

不能轻易地在评论中转达这一点

尝试更改循环，如下所示：

For Each Sheet In wb2.Sheets
    With Sheet
        Intersect(.UsedRange, .Range("A:A,B:B,F:F")).Copy PasteStart
        Set PasteStart = Sheets("Data").Range("A" & Rows.Count).End(xlUp)(2)
    End With
Next Sheet

---

每列中的数据行数是否相同？如果没有，您需要考虑到这一点。

可能我过度简化了这一点，但如果您只是想将列复制到其他工作表，请尝试以下操作：

---

编辑：添加了文件选择选项

Sub CopySpecificColumns()

    Dim oSourceWB As Workbook
    Dim oSourceSheet As Worksheet
    Dim oDestSheet As Worksheet: Set oDestSheet = ThisWorkbook.Worksheets("Sheet4")         ' Set your destination sheet here
    Dim aColsToCopy, aDestColumns, sWBToOpen
    Dim iC As Long

    ' Get filename
    sWBToOpen = Application.GetOpenFilename("Report Files (*.csv),", , "Please chose a Report to Parse", , False)

    ' Check that a file was selected
    If sWBToOpen = "False" Then Exit Sub

    ' Open workbook and set source sheet
    Set oSourceWB = Workbooks.Open(sWBToOpen)
    Set oSourceSheet = oDestWB.Sheets("Checklist")

    aColsToCopy = Array("B", "C", "E")      ' Set your cource columns here
    aDestColumns = Array("A", "B", "C")     ' Set your destination columns here

    ' Loop to copy columns
    For iC = LBound(aColsToCopy) To UBound(aColsToCopy)
        With oSourceSheet
            .Range(aColsToCopy(iC) & "1:" & aColsToCopy(iC) & .Range(aColsToCopy(iC) & .Rows.Count).End(xlUp).Row).Copy oDestSheet.Range(aDestColumns(iC) & "1")
        End With
    Next

    ' Close source workbook
    oSourceWB.Close False

    ' Clear objects
    Set oSourceSheet = Nothing
    Set oDestSheet = Nothing
    Set oSourceWB = Nothing

End Sub

---

您可以添加一些内容，如“无屏幕更新是您想要的”

可能我过度简化了此操作，但如果您只想将列复制到其他工作表，请尝试以下操作：

---

编辑：添加了文件选择选项

Sub CopySpecificColumns()

    Dim oSourceWB As Workbook
    Dim oSourceSheet As Worksheet
    Dim oDestSheet As Worksheet: Set oDestSheet = ThisWorkbook.Worksheets("Sheet4")         ' Set your destination sheet here
    Dim aColsToCopy, aDestColumns, sWBToOpen
    Dim iC As Long

    ' Get filename
    sWBToOpen = Application.GetOpenFilename("Report Files (*.csv),", , "Please chose a Report to Parse", , False)

    ' Check that a file was selected
    If sWBToOpen = "False" Then Exit Sub

    ' Open workbook and set source sheet
    Set oSourceWB = Workbooks.Open(sWBToOpen)
    Set oSourceSheet = oDestWB.Sheets("Checklist")

    aColsToCopy = Array("B", "C", "E")      ' Set your cource columns here
    aDestColumns = Array("A", "B", "C")     ' Set your destination columns here

    ' Loop to copy columns
    For iC = LBound(aColsToCopy) To UBound(aColsToCopy)
        With oSourceSheet
            .Range(aColsToCopy(iC) & "1:" & aColsToCopy(iC) & .Range(aColsToCopy(iC) & .Rows.Count).End(xlUp).Row).Copy oDestSheet.Range(aDestColumns(iC) & "1")
        End With
    Next

    ' Close source workbook
    oSourceWB.Close False

    ' Clear objects
    Set oSourceSheet = Nothing
    Set oDestSheet = Nothing
    Set oSourceWB = Nothing

End Sub

---

---

您可以添加一些内容，如“不更新屏幕是您想要的”

是否尝试使用Excel txt助手？尝试以txt格式导入数据并选择您的csv文件。@DavidGarcíaBodego感谢您的建议，但确实不想使用它。您能上传一个示例吗？据我所知，您的代码已经在运行，但它正在导入所有数据。另一个建议是：使用宏记录器使用Excel txt助手导入数据。您将获得的代码将对您有所帮助。您可以执行以下操作：

Intersect（ActiveSheet.UsedRange，Range（“A:A，E:E，F:F”）

或使用

Union

。您如何决定复制哪些列？还是需要复制的静态列？是否尝试使用Excel txt助手？尝试以txt格式导入数据并选择您的csv文件。@DavidGarcíaBodego感谢您的建议，但确实不想使用它。您能上传一个示例吗？据我所知，您的代码已经在运行，但它正在导入所有数据。另一个建议是：使用宏记录器使用Excel txt助手导入数据。您将获得的代码将对您有所帮助。您可以执行以下操作：

Intersect（ActiveSheet.UsedRange，Range（“A:A，E:E，F:F”）

或使用

Union

。您如何决定复制哪些列？还是您需要复制的静态列？谢谢。似乎可以工作，但在某些情况下，单元格将有空白数据，但我仍希望将其复制为空白，这会导致问题吗？使用

UsedRange

不是最可靠的方法-如果空白数据“在”使用范围内，它将包括空白数据，但如果它们位于上次使用的行之后，则不包括空白数据。最好使用

end（xlup）

公式。这不是一种简单的方法吗？源上只有一张数据表，所以我只需要将A:A复制到A列，例如将E:E复制到B列？您不能复制整个列，因为当您到达第二张数据表时，您将离开目标数据表的底部。因此不需要循环。您可以使用

.Range（“A:A，B:B，F:F”）。复制…

谢谢。似乎可以工作，但在某些情况下，单元格将有空白数据，但我仍希望将其复制为空白，这会导致问题吗？使用

UsedRange

不是最可靠的方法-如果空白数据“在”使用范围内，它将包括空白数据，但如果它们位于上次使用的行之后，则不包括空白数据。最好使用

end（xlup）

公式。这不是一种简单的方法吗？源上只有一张数据表，所以我只需要将A:A复制到A列，例如将E:E复制到B列？您不能复制整个列，因为当您到达第二张数据表时，您将离开目标数据表的底部。因此不需要循环。你可以使用

.Range（“A:A，B:B，F:F”）。复制…

Hi-Zac，基本上就是这样，但我需要打开一个文件浏览器并将其用作源，然后将其移动到另一个文件添加文件选择Hi-Zac，基本上就是这样，但我需要打开一个文件浏览器并将其用作源，并将其移动到其他文件添加文件选择