VBA代码使用for循环跨工作簿中的所有工作表来selectvariables内容？

我有一个工作簿与多个工作表，在每张工作表中，我需要将相同的行内容复制到我的主列表。 我有一个代码来获取每个工作表中的一个单元格值（这是N7）给我的主人，

问题是，在一些表单中，要进入主单元格的单元格值将是一个单元格，而在其他表单中，它将是两个或更多单元格，如（N7到N11）

我应该怎样把这个交给我的主人？ 我现在的代码是，

Dim DataFile As String Workbooks.Open Filename:=Range("T3").Value DataFile = ActiveWorkbook.Name ThisWorkbook.Activate Range("C4").Select For i = 1 To Workbooks(DataFile).Worksheets.Count ActiveCell.Value = Workbooks(DataFile).Worksheets(i).Range("N7").Value ActiveCell.Offset(1, 0).Select Next i 

请帮助我。

Answer 1

如果您将MasterFileSheetNameHere更改为您的工作表名称，以下应该很好地工作

 Option Explicit Sub CopyFromEachSheet() Dim CurrentWorkSheet As Worksheet Dim DataFile As Workbook Dim DataFileLastRow As Long Dim MasterFileSheet As Worksheet Dim MasterFileLastRow As Long Dim RangeToCopy As Range Dim DataFileRowCount As Long 'Assuming that this scipt will be in your master file 'Replace with youor sheet name Set MasterFileSheet = ThisWorkbook.Sheets("MasterFileSheetNameHere") Set DataFile = Workbooks.Open(Filename:=MasterFileSheet.Range("T3").Value) For Each CurrentWorkSheet In DataFile.Sheets With MasterFileSheet MasterFileLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row End With With CurrentWorkSheet DataFileLastRow = .Cells(.Rows.Count, "N").End(xlUp).Row End With Set RangeToCopy = CurrentWorkSheet.Range("N7:N" & DataFileLastRow) 'To insert rows before pasting into new rows If RangeToCopy.Rows.Count > 1 Then '-1 to counter the +2 below so that the additional rows are added below the first row in MasterFile For DataFileRowCount = 1 To RangeToCopy.Rows.Count - 1 MasterFileSheet.Range("C" & MasterFileLastRow + 2).EntireRow.Insert xlDown Next DataFileRowCount End If 'Use this code to paste the values from DataFile to MasterFile RangeToCopy.Copy MasterFileSheet.Range("C" & MasterFileLastRow + 1 & _ ":C" & MasterFileLastRow + 1 + RangeToCopy.Rows.Count) 'Use this code if you want to transpose '+1 here allows you to insert to the next unused line 'MasterFileSheet.Range("C" & MasterFileLastRow + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True Next CurrentWorkSheet End Sub 

Answer 2

HI Divya下面的代码可能对你有所帮助

 Sub Selectvalue() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets Lastrow = Workbooks("Mastersheet").Sheets("sheet1").Range("C" & Rows.Count).End(xlUp).Row Workbooks("Mastersheet").Sheets("sheet1").Range("C" & Lastrow).Offset(1, 0) = ws.Range("N7:N" & Cells(Rows.Count, "N").End(xlUp).Row) Next ws End Sub