Please help me
what is wrong with my code, i can't seem to loop the code for the sheets that I have selected using the listbox.
please see my codes here and advise what i need to change.
Private Sub UserForm_Initialize()
Dim ExcludedSheets As Variant
Dim oneSheet As Worksheet
ExcludedSheets = Array("Master", "Vessel", "Location")
For Each oneSheet In ThisWorkbook.Sheets
With oneSheet
If IsError(Application.Match(.Name, ExcludedSheets, 0)) Then
ListBox1.AddItem .Name
End If
End With
Next oneSheet
End Sub
This is my userform listbox
Private Sub btn_Vessel_Click()
'This macro will copy all rows from the first sheet
'(including headers)
'and on the next sheets will copy only the data
'(starting on row 3)
Dim i As Integer
Dim j As Long
Dim SheetCnt As Integer
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim lastCol As Integer
Dim ws1 As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
'Delete the Target Sheet on the document (in case it exists)
Sheets("Vessel").Delete
'Count the number of sheets on the Workbook
SheetCnt = Worksheets.Count
'Add the Target Sheet
Sheets.Add after:=Worksheets(SheetCnt)
ActiveSheet.Name = "Vessel"
Set ws1 = Sheets("Vessel")
lastRow2 = 3
'Define the row where to start copying
'(first sheet will be row 3 to include headers)
j = 3
'Combine the sheets
For i = 0 To ListBox1.ListCount
Worksheets(i).Select
'check what is the last column with data
lastCol = ActiveSheet.Cells(2, ActiveSheet.Columns.Count).End(xlToLeft).Column
'check what is the last row with data
lastRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row + 3 '+3 due to row 1 to 3 of column C is blank
'Define the range to copy
Range("A" & j, Cells(lastRow1, lastCol)).Select
'Copy the data
Selection.Copy
ws1.Range("A" & lastRow2).PasteSpecial
Application.CutCopyMode = False
'Define the new last row on the Target sheet
With ws1
lastRow2 = .Cells(.Rows.Count, "C").End(xlUp).Row + 3 '+3 to start on the next row after the last row
End With
'Define the row where to start copying
'(2nd sheet onwards will be row 5 to only get data)
j = 5
Next
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Sheets("Vessel").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
Unload UserForm1
End Sub
This is the button where I want to run the macro for the sheets selected.
Bookmarks