Consulting

Results 1 to 8 of 8

Thread: Help me please! Basic Excel macro!

  1. #1
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    2
    Location

    Help me please! Basic Excel macro!

    I have this very simple macro to copy and past, values only, into certain cells within a worksheet.

    I need the action to report on all but the first 9 sheets in the workbook (300 in total).

    The macro below seems to be running but it is only actually performing the action on the first sheet in the sequence, sheet 10, all the rest remain unaltered.

    Am I missing something very simple?

    Sub DeleteActionData()
    Dim ws As Worksheet
    For Each sh In ThisWorkbook.Worksheets
    Select Case sh.Name
    Case Is = "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"
    Case Else
    Range("C121:M130").Select
        Selection.Copy
        Range("C121").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End Select
    Next sh
    End Sub
    Last edited by Paul_Hossler; 04-06-2020 at 05:13 AM.

  2. #2
    Hi & welcome to the board.
    How about
    Sub DeleteActionData()
       Dim Ws As Worksheet
       For Each Ws In ThisWorkbook.Worksheets
          Select Case Ws.Name
             Case Is = "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"
             Case Else
                With Ws.Range("C121:M130")
                   .Value = .Value
                End With
          End Select
       Next Ws
    End Sub

  3. #3
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    2
    Location

    Thanks Fluff

    I feel a bit stupid right now!

    The code I included actually works - problem is the other sheets in the file were 'highlighted' which is what was stopping the macro from working.

    Thanks for your help though.


    Quote Originally Posted by Fluff View Post
    Hi & welcome to the board.
    How about
    Sub DeleteActionData()
       Dim Ws As Worksheet
       For Each Ws In ThisWorkbook.Worksheets
          Select Case Ws.Name
             Case Is = "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"
             Case Else
                With Ws.Range("C121:M130")
                   .Value = .Value
                End With
          End Select
       Next Ws
    End Sub

  4. #4
    You're welcome & thanks for the feedback.
    However your original code will only convert the cells to values on whichever sheet is active when you run the macro.

  5. #5
    Hello All,

    I am trying to copy the data from multiple sheets of a workbook into master workbook but getting script error 9. Please help.

    Sub Rajeev()
    Dim temp As New Workbook, wkb As Workbook
    Dim sh, sh1, sh2, sh3, sh4, sh5, sh6 As Worksheet, w_dpr As Worksheet, w_cc As Worksheet, w_c1 As Worksheet, w_c2 As Worksheet, w_c3 As Worksheet, w_c4 As Worksheet, w_c5 As Worksheet, w_dpr1 As Worksheet, w_dpr2 As Worksheet, w_c9 As Worksheet
    Dim MyFolder As String
    Dim MyFile As String
    Dim lRow As Long
    Dim lrow1 As Long


    Dim j As Integer, k As Integer, L As Integer


    Set wkb = ThisWorkbook
    Set w_dpr = wkb.Sheets("INSTALL(WIP)")
    Set w_dpr1 = wkb.Sheets("Disconnect(WIP)")
    Set w_dpr2 = wkb.Sheets("CCD")
    Set w_cc = wkb.Sheets("Test & Accept Queue")
    Set w_c1 = wkb.Sheets("Cancel Orders")
    Set w_c2 = wkb.Sheets("Onshore Reassignment")
    'Set w_c3 = wkb.Sheets("Billed_RTP-Orders")
    'Set w_c4 = wkb.Sheets("CCD")
    Set w_c5 = wkb.Sheets("ClickIT Tickets")




    w_dpr.Range("A2:Z1000000").ClearContents
    w_dpr1.Range("A2:Z1000000").ClearContents
    w_dpr2.Range("A2:Z1000000").ClearContents


    MyFolder = wkb.Sheets("Overall Snapshot").Range("AQ1").Value
    MyFile = Dir(MyFolder & "\*.xls*")
    Do While MyFile <> ""
    Set temp = Workbooks.Open(Filename:=MyFolder & "" & MyFile)


    On Error Resume Next
    temp.Activate
    Set sh = ActiveWorkbook.Sheets("INSTALL(WIP)")

    If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    Else
    temp.Activate
    sh.Activate
    If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
    End If


    lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row


    sh.Range("A2:Z" & lRow).Copy


    wkb.Activate
    w_dpr.Activate

    lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    lrow1 = lrow1 + 1


    w_dpr.Range("A" & lrow1).Activate
    w_dpr.Range("A" & lrow1).PasteSpecial


    Application.CutCopyMode = False


    End If


    On Error Resume Next
    temp.Activate
    Set sh1 = ActiveWorkbook.Sheets("Test & Accept Queue")
    If Err.Number <> 0 Then
    'MsgBox "The sheet doesn't exist"
    Err.Clear
    On Error GoTo 0
    Else
    temp.Activate
    sh1.Activate


    If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
    End If




    lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    sh1.Range("A2:Z" & lRow).Copy


    wkb.Activate
    w_cc.Activate


    lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    lrow1 = lrow1 + 1


    w_cc.Range("A" & lrow1).Activate
    w_cc.Range("A" & lrow1).PasteSpecial




    Application.CutCopyMode = False

    End If


    On Error Resume Next
    temp.Activate
    Set sh2 = ActiveWorkbook.Sheets("Cancel Orders")
    If Err.Number <> 0 Then
    'MsgBox "The sheet doesn't exist"
    Err.Clear
    On Error GoTo 0
    Else
    temp.Activate
    sh2.Activate


    If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
    End If




    lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    sh2.Range("A2:Z" & lRow).Copy


    wkb.Activate
    w_c1.Activate


    lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    lrow1 = lrow1 + 1


    w_c1.Range("A" & lrow1).Activate
    w_c1.Range("A" & lrow1).PasteSpecial




    Application.CutCopyMode = False

    End If



    On Error Resume Next
    Set sh3 = ActiveWorkbook.Sheets("Disconnect(WIP)")

    If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    Else
    temp.Activate
    sh3.Activate
    If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
    End If


    lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row


    sh3.Range("A2:Z" & lRow).Copy


    wkb.Activate
    w_dpr1.Activate

    lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    lrow1 = lrow1 + 1


    w_dpr1.Range("A" & lrow1).Activate
    w_dpr1.Range("A" & lrow1).PasteSpecial


    Application.CutCopyMode = False


    End If


    On Error Resume Next
    temp.Activate
    Set sh4 = ActiveWorkbook.Sheets("CCD")

    If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    Else
    temp.Activate
    sh4.Activate
    If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
    End If


    lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row


    sh4.Range("A2:Z" & lRow).Copy


    wkb.Activate
    w_dpr2.Activate

    lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    lrow1 = lrow1 + 1


    w_dpr2.Range("A" & lrow1).Activate
    w_dpr2.Range("A" & lrow1).PasteSpecial


    Application.CutCopyMode = False


    End If


    temp.Close savechanges:=False
    MyFile = Dir
    Loop


    wkb.Activate


    w_dpr.Activate
    w_dpr.Range("A1:A1000").Select
    On Error Resume Next
    w_dpr.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Rows("2:1000").RowHeight = 15
    On Error GoTo 0


    w_cc.Activate
    w_cc.Range("A1:A1000").Select
    On Error Resume Next
    w_cc.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    Rows("2:1000").RowHeight = 15


    w_c1.Activate
    w_c1.Range("A1:A1000").Select
    On Error Resume Next
    w_c1.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Rows("2:1000").RowHeight = 15
    On Error GoTo 0




    End Sub

  6. #6
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    @rajguptaji, please start your own post.

  7. #7
    How to do that

  8. #8

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •