我有多個時間表工作簿設置具有員工名稱和多個不同小時類型的列(如基地時間,假期支付,病假工資)。見圖片。 VBA複製和粘貼從多列轉移數據
我需要代碼才能夠爲每個員工複製小時類型(標題)和值爲4列。
例如。
Employee 1 Base Hours 37.50
Employee 1 Sick Hours 15.00
Employee 1 Group Leader 20.00
Employee 2 Base Hours 50.00
Employee 2 Holiday Pay 60.00
我有一些代碼將數據複製到模板當前,但堅持如何複製它如上。
Sub Consolidate()
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
folderPath = "C:\Users\preena.j\Documents\Payroll\TimeSheet - MYOB"
'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
wb.Sheets("Timesheet").Range("A9:N" & Range("A" &
Rows.Count).End(xlUp).Row).Copy
Workbooks("MYOBTimeSheetImport").Worksheets("MYOBTimeSheetImport").Range("A"
& Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
Workbooks(Filename).Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
FPath = "C:\Users\preena.j\Documents\Payroll\TimeSheet - MYOB"
FName = "MYOBTimeSheetImport_" & Format(Now(), "YYYYMMDD")
Set NewBook = Workbooks.Add
ThisWorkbook.Sheets("MYOBTimeSheetImport").Copy Before:=NewBook.Sheets(1)
If Dir(FPath & "\" & FName) <> "" Then
MsgBox "File " & FPath & "\" & FName & " already exists"
Else
NewBook.SaveAs Filename:=FPath & "\" & FName, FileFormat:=xlCSV
End If
NewBook.Close savechanges:=True
End Sub
這看起來像一個普通的 「逆透視」 操作:這裏有一個VBA解決方案 - https://stackoverflow.com/questions/36365839/excel-macrovba-to-transpose -multiple-columns-to-multiple-rows/36366394#36366394 –
@TimWilliams謝謝 - 我遇到了麻煩,以適應上述代碼。我得到一個運行時錯誤9下標超出範圍。 – Preena