我有一点问题:我有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。
欢迎任何帮助。谢谢。
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
答案 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
这是未经过测试的,有人只是在这里给你写了一个代码,只是让你知道....