VBA代码遍历表格并将特定数据复制到特定的单元格 [英] VBA code to iterate through sheets and copy specific data to specific cells

问题描述

链接到示例工作簿： http ：//www.wikisend.com/download/245286/MIS%20-%20July%20%20（1）.xlsm

该工作簿有vba代码，删除所有的sheeets，然后通过从其他工作簿复制表创建新的表。

The workbook has vba code which deletes all sheeets and then creates new sheet by copying sheets from other workbooks.

我想要另一个vba代码自动生成执行摘要表与所有的格式和数据。一些公式没有很好地定义，所以它们将被稍后手动编辑。因为其他工作表每个月都会改变，手工引用一下就会很麻烦

I want another vba code to automatically generate Executive Summary sheet with all formating and data.Some formulas arent well defined so they will have to be edited manually later. As other worksheets witll change every month manual referencing wud be tedious

我目前的代码：

    Sub WorksheetLoop()

        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Select
        Sheets(Sheets.Count).Name = "Executive Summary"


        Sheets("Executive Summary").Select
'Some formatting code on sheet Executive Summary

    Dim ws As Worksheet
       ' Begin the loop.
currentRow=6 'start entering data from row 6
     For Each ws In ThisWorkbook.Worksheets

'Assign cell at row=current row and col B reference to cell G5 at sheet ws
'Assign cell at row=current row and col F reference to cell J15 at sheet ws

'Assign cell at row=current row and col H reference to cell T5 at sheet ws


'increment Current row by 1
    'don't know what to do here    
    Next ws

'select entire region( all filled cells)
'format text, add border etc

    End Sub

请告诉我引用的语法

推荐答案

解决问题

Sub test()

    Sheets("Executive Summary").Select
    Range("A6:P23").Select
    Range("P6").Activate
    Selection.ClearContents
    'Dim ws As Worksheet
    Dim Row As Integer
    Row = 6
    For Each ws In ThisWorkbook.Worksheets
     If ws.Name <> "Executive Summary" Then
        Range("A" & Row).Value = "='" & ws.Name & "'!C3"
        Range("B" & Row).Value = "='" & ws.Name & "'!G5"
        Range("C" & Row).Value = "='" & ws.Name & "'!G39"
        Range("D" & Row).Value = "='" & ws.Name & "'!H39"
        Range("E" & Row).Value = "=D" & Row & "-C" & Row
        Range("F" & Row).Value = "=IF(A" & Row & "=" & Chr(34) & "POWER" & Chr(34) & ",+E" & Row & "*B" & Row & ",+E" & Row & "*B" & Row & "/100)"
        Range("G" & Row).Value = "=IF(A" & Row & "=" & Chr(34) & "POWER" & Chr(34) & ",+(J" & Row & "-D" & Row & ")*B" & Row & ",+(J" & Row & "-D" & Row & ")*B" & Row & "/100)"
        '"=(J" & Row & "-D" & Row & ")*B" & Row & "/100"
        Range("H" & Row).Value = "=I" & Row & "-F" & Row & "-G" & Row
        Range("I" & Row).Value = 0
        Range("J" & Row).Value = "='" & ws.Name & "'!I39"
        Range("K" & Row).Value = "='" & ws.Name & "'!L5"
        Range("L" & Row).Value = "='" & ws.Name & "'!K39"
        Range("M" & Row).Value = "=G" & Row
        Range("N" & Row).Value = "=O" & Row & "-L" & Row & "-M" & Row
        Range("O" & Row).Value = "=I" & Row
        Range("P" & Row).Value = "='" & ws.Name & "'!M39"
        Row = Row + 1
     End If

     Next ws

End Sub

这篇关于VBA代码遍历表格并将特定数据复制到特定的单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！