VBA для копирования определенных столбцов на конкретные листы

Question

Пожалуйста, помогите - я нашел ниже код здесь, и он работает. Однако в данный момент он копирует всю строку на конкретный лист - я хочу, чтобы он копировал определенные столбцы с одного листа в определенные столбцы на другом.

например, у меня есть таблица с вкладками неделя 1, неделя 2, неделя 3 и т. Д. Я хочу, чтобы макрос вошел и скопировал столбцы A, F, H с недели 1 на вкладке исходного листа - в B, G & I, на неделю 1 на моей вкладке электронной таблицы - затем цикл на 2 и 3 недели и т. Д.

Надеюсь, что это имеет смысл - любая помощь будет оценена

Sub Consolidate()
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet

'Setup
Application.ScreenUpdating = False  'speed up macro 
execution
Application.EnableEvents = False    'turn off other macros 
for now
Application.DisplayAlerts = False   'turn off system 
messages for now

Set wsMaster = ThisWorkbook.Sheets("Month End Summary")    
'sheet report is built into

With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
    .UsedRange.Offset(8).EntireRow.Clear
    NR = 9
Else
    NR = .Range("A" & .rows.Count).End(xlUp).Row + 1    
'appends data to existing data
End If

'Path and filename (edit this section to suit)

   MsgBox "Please select a folder with files to consolidate"
Do
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\2010\Test\"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fPath = .SelectedItems(1) & "\"
            Exit Do
        Else
            If MsgBox("No folder chose, do you wish to 
abort?", _
                vbYesNo) = vbYes Then Exit Sub
        End If
    End With
Loop

fPathDone = fPath & "Imported\"     'remember final \ in 
this string
On Error Resume Next
    MkDir fPathDone                 'creates the completed 
folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.xls*")       'listing of desired 
files, edit filter as desired

'Import a sheet from found files
Do While Len(fName) > 0
    If fName <> ThisWorkbook.Name Then              'don't 
reopen this file accidentally
        Set wbData = Workbooks.Open(fPath & fName)  'Open 
file
    'This is the section to customize, replace with your own 
action code as needed

      Dim ws As Worksheet
For Each ws In wbData.Sheets(Array("Month End Summary"))
    LR = ws.Range("B" & ws.rows.Count).End(xlUp).Row 'Find 
last row
    If NR = 1 Then 'copy the data AND titles
        ws.Range("A9:A" & LR).EntireRow.Copy .Range("A" & 
NR)
    Else 'copy the data only
        ws.Range("A9:A" & LR).EntireRow.Copy .Range("A" & 
NR)
    End If
    NR = .Range("A" & .rows.Count).End(xlUp).Row + 1 'Next 
row
Next ws
        wbData.Close False                                
'close file
        Name fPath & fName As fPathDone & fName           
'move file to IMPORTED folder
    End If
    fName = Dir                                       'ready 
next filename
Loop
End With


ErrorExit:    'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True         'turn system alerts 
back on
Application.EnableEvents = True          'turn other macros 
back on
Application.ScreenUpdating = True        'refreshes the 
screen

End Sub

Answer 1

Попробуйте это:

Sub CopyColumns()
    Dim Source As Workbook, Target As Workbook, sht As Worksheet

    Set Source = Workbooks("Source")
    Set Target = Workbooks("Target")

    For Each sht In Source.Sheets
        sht.Range("A1").EntireColumn.Copy Destination:=Target.Worksheets(sht.Name).Range("B1").EntireColumn
        sht.Range("F1").EntireColumn.Copy Destination:=Target.Worksheets(sht.Name).Range("G1").EntireColumn
        sht.Range("H1").EntireColumn.Copy Destination:=Target.Worksheets(sht.Name).Range("I1").EntireColumn
    Next sht
End Sub

Некоторые вещи на заметку:

1. Предполагается, что у вас есть две открытых рабочих книги: Source и Target
2. Предположим, что имена листов точно одинаковы в каждой книге