我的工作簿中有5个工作表(表1、表2、表3、表4及其组合)。主工作表是我试图将其他4个合并到一起,并将数据放在下一个空行中的工作表。
几周来,我一直在谷歌上搜索不同的代码解决方案,但都无济于事。
当我单步执行宏并使用循环(do while、for和Each)时,它只是完美地遍历了表1。但是我不能让它在表2-4中循环。
我想我知道我的问题在哪里,但在我几周的谷歌搜索中,我仍然找不到解决方案。我想问题出在"Sheets("Table 1").Select“这一行。因为代码似乎会一直工作,直到它到达这一行。然后“当然”返回到表1。
这是一个更大项目的测试组。我必须从500个文档中提取信息,这些文档都设置在完全相同的位置,但我必须首先让这4个文档正常工作。
“我试过了:
Dim iSheet As Object
For Each iSheet In ThisWorkbook.Sheets
MsgBox iSheet.Name
Next iSheet“我试着这样做:
Dim useWorkSheet As Worksheet
Dim totalWorkSheet As Worksheet
Dim tableAsNumeric As Integer
Dim startingTable As Integer
'For Each Current In Worksheets
'Table Name = Table in Worksheets
startingTable = 1
Set totalWorkSheet = ActiveWorkbook.Sheets("Table 1")
For Each useWorkSheet In ActiveWorkbook.Worksheets
tableAsNumeric = Val(useWorkSheet.Name)
'If tableAsNumeric >= startingTable Then
'Do While I >= Worksheet("Table 1")
'I = I + 1“我还尝试了一个for循环,以及网络上所有其他的循环……都不起作用……
这是我需要帮助的代码:
Sub TFRdataExtract()
'
' TFRdataExtract Macro
' Extract Data from Individual TFR files to the combined file.
'
' Keyboard Shortcut: Ctrl+e
'
Dim iSheet As Object
For Each iSheet In ThisWorkbook.Sheets
MsgBox iSheet.Name
Sheets("Table 1").Select
Range("AB1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-27], 7,100)"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-24], 14,100)"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-19],23,100)"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-10],22,100)"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-16], 10,100)"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[1]C[-13],13,100)"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-34],22,100)"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-25],18,100)"
Range("AK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[2]C[-16],21,100)"
Range("AL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-37],21,100)"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-28],17, 100)"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[3]C[-21],34,100)"
Range("AO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-40],28,100)"
Range("AP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-35], 7,100)"
Range("AQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-34],10,100)"
Range("AR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-29],10,100)"
Range("AS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[4]C[-21],22,100)"
Range("AT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[5]C[-45],26,100)"
Range("AU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[6]C[-46],18,100)"
Range("AV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[6]C[-37],55,100)"
Range("AW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-48],36,100)"
Range("AX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-39],30,100)"
Range("AY1").Select
ActiveCell.FormulaR1C1 = "=MID(R[7]C[-28],12,100)"
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-51],20,100)"
Range("BA1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-35],12,100)"
Range("BB1").Select
ActiveCell.FormulaR1C1 = "=MID(R[8]C[-31],20,100)"
Range("BC1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-54],25,100)"
Range("BD1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-45],15,100)"
Range("BE1").Select
ActiveCell.FormulaR1C1 = "=MID(R[9]C[-39],23,100)"
Range("BF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-57],17,100)"
Range("BG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-56],17,100)"
Range("BH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-52],13,100)"
Range("BI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-42],14,100)"
Range("BJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[10]C[-38],15,100)"
Range("BK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],11,100)"
Range("BL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],12,100)"
Range("BM1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-59],10,100)"
Range("BN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-57], 7,100)"
Range("BO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],7,100)"
Range("BP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],11,100)"
Range("BQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-53],12,100)"
Range("BR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-50],8,100)"
Range("BS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[12]C[-47],12,100)"
Range("BT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],10,100)"
Range("BU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],20,100)"
Range("BV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-66],10,100)"
Range("BW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-63],10,100)"
Range("BX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-62],8,100)"
Range("BY1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-61],7,100)"
Range("BZ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-59],9,100)"
Range("CA1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-57],10,100)"
Range("CB1").Select
ActiveCell.FormulaR1C1 = "=MID(R[13]C[-55],13,100)"
Range("CC1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],12,100)"
Range("CD1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],13,100)"
Range("CE1").Select
ActiveCell.FormulaR1C1 = ""
Range("CE1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-77],15,100)"
Range("CF1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-72],7,100)"
Range("CG1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-71],13,100)"
Range("CH1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-67],14,100)"
Range("CI1").Select
ActiveCell.FormulaR1C1 = "=MID(R[14]C[-62],7,100)"
Range("CJ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-87],13,100)"
Range("CK1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-85],15,100)"
Range("CL1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-82],11,100)"
Range("CM1").Select
ActiveCell.FormulaR1C1 = "L16,11,100)"
Range("CN1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-73],15,100)"
Range("CO1").Select
ActiveCell.FormulaR1C1 = "=MID(R[15]C[-68],8,100)"
Range("CP1").Select
ActiveCell.FormulaR1C1 = "=MID(R[17]C[-93],19,100)"
Range("CQ1").Select
ActiveCell.FormulaR1C1 = "=MID(R[17]C[-80],22,100)"
Range("CR1").Select
ActiveCell.FormulaR1C1 = "=MID(R[18]C[-95],27,100)"
Range("CS1").Select
ActiveCell.FormulaR1C1 = "=MID(R[18]C[-82],18,100)"
Range("CT1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-97],45,100)"
Range("CU1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-89],22,100)"
Range("CV1").Select
ActiveCell.FormulaR1C1 = "=MID(R[19]C[-81],49,100)"
Range("CW1").Select
ActiveCell.FormulaR1C1 = "=MID(R[20]C[-91],21,100)"
Range("CX1").Select
ActiveCell.FormulaR1C1 = "=MID(R[21]C[-101],16,100)"
Range("CY1").Select
ActiveCell.FormulaR1C1 = "=MID(22,27,100)"
Range("CZ1").Select
ActiveWindow.SmallScroll Down:=-3
Range("CY1").Select
ActiveWindow.SmallScroll ToRight:=-50
Range("AB1:CY1").Select
Range("CY1").Activate
Selection.Copy
Sheets("Combined").Select
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next iSheet
End Sub我需要遍历所有4个工作表,并将数据粘贴到组合文件中的下一个空行。
发布于 2019-03-28 06:26:25
试试这个:
For sht = 1 To Sheets.Count
Debug.Print sht
'your code here
Sheets(sht).Activate'or
Sheets(Sheets(sht).Name).Activate
Next发布于 2019-03-28 07:12:16
这应该是可行的:
Sub TFRdataExtract()
Dim iSheet As Worksheet, rngCopy As Range
For Each iSheet In ThisWorkbook.WorkSheets
If iSheet.Name Like "Table*" Then
With iSheet '<< no need to activate!
.Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)" '<< no need to select!
.Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
.Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
'etc etc
Set rngCopy = .Range("AB1:CY1")
End with
'assign values directly
With ThisWorkbook.Sheets("Combined").Range("A2")
.Resize(rngCopy.Rows.Count, _
rngCopy.Columns.Count).Value = rngCopy.Value
End with
End If 'EDIT - added
Next iSheet
End Sub发布于 2019-03-28 07:22:48
也许这会有所帮助。注释,以帮助理解正在发生的事情。
'// Modify as desired, like to empty rows/columns.
Private Function GetRangeToCopy(zWorksheet As Worksheet) As Range
Set GetRangeToCopy= zWorksheet.UsedRange
End Function
'// Modify to add spacing or whatnot.
Private Function GetDestinationRange(zDestinationWorksheet As Worksheet, zRowCount As Long, zColumnCount As Long) As Range
Dim zReturnRange As Range
Dim zNewRowIndex As Long
Let zNewRowIndex = zDestinationWorksheet.UsedRange.End.Row + 3 '// Increase to add more rows between inserts.
Set zReturnRange = zDestinationWorksheet.
Set GetDestinationRange = zReturnRange
End Function
'// Copies a range to the destination range.
Private Sub CopyRange(zSourceRange As Range, zDestinationRange As Range)
'// This is where copying styles and such would be done.
'// We will just call copy for simplicity.
'// Clear.
Call zDestinationRange.Clear
'// Copy.
Call zSourceRange.Copy(zDestinationRange)
End Sub
'// Copy worksheets to a destination worksheet.
'// Destination worksheet can be a worksheet loaded into a different workbook altogether.
Public Sub CopyWorksheetsTo(zDestinationWorksheet As Worksheet, zClearDestinationWorksheet As Boolean = False _
zPopupCurrentWorksheet As Boolean = True)
Dim zCurrentWorksheet As Worksheet
Dim zCurrentWorksheet_Var As Variant
Dim zRangeToCopy As Range
Dim zDestinationRange As Range
'// Clear destination.
If (zClearDestinationWorksheet) Then
Call zDestinationWorksheet.UsedRange.Clear
End If
'// Cycle through each worksheet in the workbook.
ForEach zCurrentWorksheet_Var in Worksheets
'// this allow us the Intellisense while coding.
Set zCurrentWorksheet = zCurrentWorksheet_Var
'// Make sure this isn't the destination worksheet.
If (zCurrentWorksheet.Name <> zDestinationWorksheet.Name) Then
'// Popup worksheet name.
If (zPopupCurrentWorksheet) Then
Call MsgBox(zCurrentWorksheet.Name)
End If
'// Get range to be copied.
Set zRangeToCopy = GetRangeToCopy(zCurrentWorksheet)
'// Get destination range.
Set zDestinationRange = GetDestinationRange(zDestinationWorksheet)
'// Copy range.
Call CopyRange(zRangeToCopy, zDestinationRange)
End If
Next xCurrentWorksheet_Var
End Subhttps://stackoverflow.com/questions/55387365
复制相似问题