Excel VBA - Copy Sheet to new workbook X times

0
votes

I need to copy the same worksheet X times (x = sheet2 row A) into a new workbook.

For each copy I need to:

1.Change a drop down to display the next value

2.Do a Refresh (Workbook is connected to a database which pulls different information based on the value of the drop down and is not automatically refreshed)

3.Copy just the values (no formulas)

  1. Rename the sheet to the value of the drop down.

  2. Save all of the copied worksheets into 1 workbook

My code (below) which is called on a button press currently saves the sheet X times based on sheet2 rowA (as intended).

It is missing steps 1,2,4 and 5

The code I have at the moment (called on button click)

Dim x As Integer    '~~>Loop counter
Dim WS As Worksheet
Dim LastCellA As Range, LastCellB As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("Sheet2")    '~~>Sheet with names
With WS
    Set LastCellA = .Cells(.Rows.Count, "A").End(xlUp)    '~~>Column with names.
    '~~>This needs to be changed to find the range as data may not start at A1

    x = Application.WorksheetFunction.Max(LastCellA.Row)
End With



For numtimes = 1 To x
    ActiveWorkbook.Sheets("Sheet1").Copy _
            After:=ActiveWorkbook.Sheets(Worksheets.Count)
    '~~>Copy values only
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Next
2
vbaexcel
Quote: "1.Change a drop down to display the next value" what for a drop down? Data validation? Active X combo box in sheet? Combo box in a user form? And for point 2: can't you just run a RefreshAll? – Dirk Reichel
@DirkReichel The form is filled with data based on the value in the drop down. The drop down looks up the value on another sheet on the same workbook. Ah didn't know about refreshAll, I am brand new to VB(A) – Roland
@DirkReichel It is a lookup drop down. Not sure what they are called in excel. Made via data tab -> data Validation-> allow:list – Roland
@DirkReichel Sheet1(sheet to be copied) not sure which cell, call it m1 (i can change it later) – Roland

2 Answers

2
votes

Still... I'm not sure of the point that you "Import" different values based on a drop down. That may be a different macro for loding the data. Then you need to call that macro instead of the .RefreshAll.

Sub test()

  Dim uRow As Long, lRow As Long, i As Long
  Dim wb As Workbook, ws As Object

  With ThisWorkbook
    Set ws = .Sheets("Sheet2")
    With ws
      uRow = .Cells(.Rows.Count, "A").End(xlUp).End(xlUp).Row
      lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Set wb = Workbooks.Add

    For i = uRow To lRow

      .Sheets("Sheet1").Range("M1").Value = ws.Cells(i, 1).Value '<~~~ this should change the dropdown
      Calculate
      .RefreshAll
      .Sheets("Sheet1").Copy , wb.Sheets(wb.Sheets.Count)
      wb.Sheets(wb.Sheets.Count).Name = ws.Cells(i, 1).Value
    Next

    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True

    For Each ws In wb.Sheets
      ws.UsedRange.Value = ws.UsedRange.Value
    Next

  End With    
End Sub

EDIT:

If you get trouble with the Sheet2 Column A List (cus it contains empty cells resulting of formulas) you may try a different approach:

Sub test()

  Dim wb As Workbook, ws As Worksheet
  Dim xVal As Variant

  With ThisWorkbook
    Set ws = .Sheets("Sheet2")
    Set wb = Workbooks.Add

    For Each xVal In Intersect(ws.Range("A:A"), ws.UsedRange).Value
      If Len(xVal) Then
        .Sheets("Sheet1").Range("M1").Value = xVal
        Calculate
        .RefreshAll
        .Sheets("Sheet1").Copy , wb.Sheets(wb.Sheets.Count)
        wb.Sheets(wb.Sheets.Count).Name = ws.Cells(i, 1).Value
        wb.Sheets(wb.Sheets.Count).UsedRange.Value = wb.Sheets(wb.Sheets.Count).UsedRange.Value
      End If
    Next

    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True

  End With
End Sub
2
votes

Based on the code you provided, I believe this is what you are looking for.

It will loop through your list, copy sheet1 to the new workbook and name the sheet.

I am not sure what you want with looping through your dropdown list.

Sub Button1_Click()
    Dim wb As Workbook, Bk As Workbook
    Dim WS As Worksheet, sh As Worksheet
    Dim LastCellA As Long, LastCellB As Range, c As Range
    Dim LastCellRowNumber As Long
    Dim x As Integer    '~~>Loop counter

    Set wb = ThisWorkbook
    Set WS = wb.Worksheets("Sheet2")    '~~>Sheet with names
    Set sh = wb.Sheets("Sheet1")

    With WS
        LastCellA = .Cells(.Rows.Count, "A").End(xlUp).Row  '~~>Column with names.
        '~~>This needs to be changed to find the range as data may not start at A1
        Set LastCellB = .Range("A1:A" & LastCellA).SpecialCells(xlCellTypeConstants, 23)
    End With

    Set Bk = Workbooks.Add

    For Each c In LastCellB.Cells
        sh.Range("M1") = c
        sh.Copy After:=Bk.Sheets(Worksheets.Count)
        With ActiveSheet
            '~~>Copy values only
            .UsedRange.Value = .UsedRange.Value
            .Name = c
        End With
    Next c

End Sub