将数据从工作表复制到另一个步骤6

时间:2016-01-28 10:02:16

标签: excel vba excel-vba

我有一点问题:我有3个工作表:

 - a.xlsm, 
 - b.xlsm 
 - c.xlsm. 

工作表只有1张(Sheet1).3张工作表是固定的,不会改变。我真的想复制

中的细胞
  

a.xlsm- F1,L1,S1,W1(跳过6个单元格)到b.xlsm-column H-H1,   H2,H3,H4和来自a.xlsm-F2,L2,S2,W2的复制在C.xlsm-柱中   H-H1,H2,H3,H4。

欢迎任何帮助。谢谢。

enter image description here

enter image description here

Sub TestCopyData()

Dim WbA As Workbook
Dim WbB As Workbook

Set WbA = ActiveWorkbook
Set WbB = "\\hofs\Mike1.xlsm"

Dim SheetA As Worksheet
Dim SheetB As Worksheet

SheetA = WbA.Sheets("Sheet1")
SheetB = WbB.Sheets("Sheet1")

Dim RowA As Integer
Dim LastRowA As Integer

LastRowA = SheetA.Cells(SheetA.Rows.Count, 1).End(xlUp).Row

Dim ColA As Integer
Dim LastColA As Integer

LastColA = SheetA.Cells(1, SheetA.Columns.Count).End(xlToLeft).Column

如果StrComp(Sheets("SheetA").Cells(AA, 1).Value, Sheets("SheetB").Cells(A, 1).Value) = 0那么

For RowA = 1 To LastRowA
    For ColA = 1 To LastColA
        SheetB.Cells(ColA, "W").Value = SheetA.Cells(Row, (ColA * 6)).Value
    Next ColA
Next Row

Else: Exit Sub

End Sub

我使用下面的代码进行了一些测试,如果过滤器发现它会将一个单元格复制到我需要的工作表但是它不能正常工作,我会逐一列出一年中的所有日期。

Sub FetchData3()
Sheets("Sheet3").Select
    Sheets("Sheet2").Range("A1:I50000").AdvancedFilter Action:= _
    xlFilterCopy, CriteriaRange:=Range("J1:J2"), CopyToRange:=Range("A1:I1"), _
    Unique:=False

End Sub

1 个答案:

答案 0 :(得分:0)

我有一段时间,所以我制作了一个可以作为开头使用的代码,但你必须添加更多数据:

Sub TestCopyData()

    Dim WbA As Workbook
    Dim WbB As Workbook
    Dim WbC As Workbook

    Set WbA = "a.xlsm" 'you'll need to open it or define it for each workbook
    Set WbB = "b.xlsm"
    Set WbC = "c.xlsm"

    Dim SheetA As Worksheet
    Dim SheetB As Worksheet
    Dim SheetC As Worksheet

    SheetA = WbA.Sheets("Sheet1")
    SheetB = WbB.Sheets("Sheet1")
    SheetC = WbC.Sheets("Sheet1")

    Dim RowA As Integer
    Dim LastRowA As Integer

    LastRowA = SheetA.Cells(SheetA.Rows.Count, 1).End(xlUp).Row

    Dim ColA As Integer
    Dim LastColA As Integer

    LastColA = SheetA.Cells(1, SheetA.Columns.Count).End(xlToLeft).Column

    For RowA = 1 To LastRowA
        For ColA = 1 To LastColA
            SheetB.Cells(ColA, "H").Value = SheetA.Cells(Row, (ColA * 6)).Value
        Next ColA
    Next Row

End Sub

这是未经过测试的,有人只是在这里给你写了一个代码,只是让你知道....