0
我真的很感謝一些幫助,找到解決我的問題的正確方法。使用VBA重新排列數據
我通過所有工作表試圖循環(除了「表1」和「輸出」。
所有上面提到的工作表包含從A2單元格數據,最後一列和最後一行。我需要複製所有在我的「輸出」工作表中的單元格C2中的循環範圍(一個在另一個下面)
另外我在所有工作表中都有一個唯一編號(需要複製的「工作表1」和「輸出」除外在我的「輸出」工作表中輸入B2,技巧是(我正在努力工作)A1中的值需要在我的「輸出」工作表中複製下來,數字爲A2:我所有循環工作表中的最後一行
下面是我的代碼至今:
Sub EveryDayImShufflingData()
Dim ws As Worksheet
Dim PasteSheet As Worksheet
Dim Rng As Range
Dim lRow As Long
Dim lCol As Long
Dim maxRow As Integer
Dim x As String
Set PasteSheet = Worksheets("Output")
Application.ScreenUpdating = False
'Loop through worksheets except "Sheet 1" and "Output"
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name <> "Sheet1") And (ws.Name <> "Output") And (ws.Visible = True) Then
'Select the Worksheet
ws.Select
'With each worksheet
With ws
'Declare variables lRow and lCol
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'Set range exc. VIN
Set Rng = .Range(.Cells(2, 1), .Cells(lRow, lCol))
'Paste the range into "Output" worksheet
Rng.Copy
PasteSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
x = .Cells(1, 1).Value
For i = 1 To lRow
PasteSheet.Cells(i, 2).End(xlUp).Offset(1, 0) = x
maxRow = maxRow + 1
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
End If
Next ws
End Sub
任何援助將好心讚賞
感謝你亞歷克斯P!鍛鍊了魅力。 –
如果我想在代碼中添加另一層複雜性,並且在「Sheet1」中的「輸出」 - INDEX(A2:A和lastrow)中的單元格A2中,MATCH(B2,(B2:B&lastrow,0)輸出「。我怎樣才能實現這一點,並填寫公式到最後一行 –
對不起B2:B&lastrow Sheet1 –