从多个工作表导入

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

这是给我代码的人的话，希望它能帮助我找到代码中的正确位置，因为我找不到。

the following code will work from one sheet to a second sheet within the same workbook, so I would think all you have to do is qualify the Sheets properties in the two statements where WS1 and WS2 are Set (highlighted in blue) with the workbook references and the rest of the code should work from there

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

从多个工作表导入

Importing from multiple sheets

import

excel

vba