Question

我最近发布了从一个文件到另一个文件的多个工作表的导入值。我想我有解决这个问题的代码，但问题是我看不到要集成它的地方。

我的实际代码是：

Option Explicit
Sub ImportData()

Application.ScreenUpdating = False
Dim Path As String, Lstrw As Long
Dim SourceWb As Workbook
Dim TargetWb As Workbook

Path = "C:\Users\DZPH8SH\Desktop\Status 496 800 semana 12 2015.xls"    'Change this to your company workbook path
Workbooks.Open (Path)

Set SourceWb = Workbooks("Status 496 800 semana 12 2015.xls")    'Change "Source" to the name of your company workbook

'Part that needs some adjustments in down below
Set TargetWb = Workbooks("Master_Atual_2015.xlsm") 'change the file address

Lstrw = SourceWb.Sheets(1).Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
With SourceWb.Sheets(1)
    .Application.Union(.Range("D2:D" & Lstrw), .Range("F2:F" & Lstrw), .Range("I2:I" & Lstrw), .Range("M2:M" & Lstrw)).Copy Destination:=TargetWb.Sheets(1).Range("A3")

End With
SourceWb.Close savechanges:=False
Application.ScreenUpdating = True

End Sub

我需要在代码中添加以便从两个工作表中复制信息的内容是：

Sub MoveData()
  Dim LastRow As Long, WS1 As Worksheet, WS2 As Worksheet
  Set WS1 = Sheets("Sheet1")
  Set WS2 = Sheets("Sheet2")
  LastRow = WS1.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
Intersect(WS1.Rows("2:" & LastRow), WS1.Range("D:D,F:F,I:I,M:N")).Copy WS2.Range("A3")
End Sub

这是给我代码的人的引用，希望它有助于在代码中找到正确的位置，因为我无法找到它。

以下代码将在同一工作簿中从一个工作表到第二个工作表，因此我认为您所要做的就是在两个语句中设置Sheets属性，其中WS1和WS2设置为（以蓝色突出显示）工作簿引用和代码的其余部分应该在那里工作

Answer 1

总有一种不同的做事方式。这是另一种选择。

Sub Button1_Click()
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim RangeArea As Range, x

    Set WS1 = Sheets("Sheet1")
    Set WS2 = Sheets("Sheet2")
    x = 0

    For Each RangeArea In WS1.Range("D:D,F:F,I:I,M:N").SpecialCells(xlCellTypeConstants, 23).Areas
        RangeArea.Copy WS2.Range("A3").Offset(0, x)
        x = x + 1
    Next RangeArea

End Sub

从多张纸张导入

1 个答案: