Копирование данных из рабочего листа к другому пошаговом 6

Question

У меня есть немного проблемы: У меня 3 листов:

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

Рабочие листы только 1 лист (Лист1) .The 3 листов являются фиксированными и не изменение. я действительно хочу, чтобы скопировать клетки от

a.xlsm- F1, L1, S1, W1 (прыжки на 6 ячеек) для b.xlsm-колонки H- H1, H2 , H3, H4 и от .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

я сделал некоторые испытания с ниже в ведьму коде я положил все даты из год один за другим a if filte r обнаружил, что он скопирует ячейку на рабочий лист, который мне нужен, но это не сработает.

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

Answer 1

У меня было некоторое время, так что я сделал код, который вы можете использовать в качестве начала, но вам придется добавить больше данных:

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 

Это не проверено, и это действительно исключение, что кто-то просто пишет вам код здесь, просто чтобы вы знали ....