I have a workbook with a source table (In Sheet A) and power query tables (In Sheets C & D). The problem with the using ActiveWorkbook.RefreshAll is because whenever I replace the source data via copy/paste, this table also gets refreshed and the new data is lost. Say I have 4 worksheets (A, B, C, D) and only want to update the table in C & D. Here's what I tried to implement but did not work:
Sub Macro()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "A" Or "B" Then
Range("A1").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
End If
Next ws
End Sub
Or if there's a way to only refresh power query tables in my workbook, that would work too.
Try this:
Sub Macro()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "A" And ws.Name <> "B" Then
ws.Range("a1").ListObject.QueryTable.Refresh BackgroundQuery:=False
End If
Next ws
End Sub
Related
I have data in Sheet1 in range A2:D17.
I want to copy this data & paste in various multiple sheets (count of sheets are 12).
Sub CopyData()
Dim ws As Worksheet
Dim wsStart As Worksheet
Set wsStart = Worksheets("Sheet1")
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = wsStart.Name Then
wsStart.Range("A2:D17").Copy
ws.Range("A2").PasteSpecial (xlPasteAll)
End If
Next ws
End Sub
I have sheet1, sheet2 , sheet3, sheet4.
Of the 4 Sheets, sheet 1 and sheet2 has data in list. and sheet3 and sheet 4 has Pivot tables for the same.
I would like to have a VBA, in such a way that, in my workbook, if it find Sheets with list, then it shoudl Format it to table. The table should be only for the cells it has value.
I used record macro, to get the code, but i am struck how i should implement it for all my Sheets.
the code, from record macro for one sheet:
sub macro()
Cells.Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$1:$1048576"), , xlYes).Name = _
"Table2"
Cells.Select
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight9"
End Sub
I think you meant something like the code below:
Option Explicit
Sub macro()
Dim ws As Worksheet
Dim ListObj As ListObject
For Each ws In ThisWorkbook.Worksheets
With ws
For Each ListObj In .ListObjects
ListObj.TableStyle = "TableStyleLight9"
Next ListObj
End With
Next ws
End Sub
If your question is that change range to Listobject, look at follow code.
Sub macro()
Dim Ws As Worksheet
Dim LstObj As ListObject
Dim rngDB As Range, n As Integer
For Each Ws In Worksheets
With Ws
Set rngDB = .Range("a1").CurrentRegion
For Each LstObj In Ws.ListObjects
LstObj.Unlist
Next
If WorksheetFunction.CountA(rngDB) > 0 Then
n = n + 1
Set LstObj = .ListObjects.Add(xlSrcRange, rngDB, , xlYes)
With LstObj
.Name = "Table" & n
.TableStyle = "TableStyleLight9"
End With
End If
End With
Next Ws
End Sub
VBA beginner here, I've got a little problem with program I'm working on.
I need to copy data from last cell in column B from first worksheet and paste it into column A in another worksheet xws, and repeate this operation for five other worksheets with data.
Here's the code, it doesn't work the way it should:
Sub exercise()
Dim ws As Worksheet
Dim rng As Range
'Finding last row in column B
Set rng = Range("B" & Rows.Count).End(xlUp)
For Each ws In ActiveWorkbook.Worksheets
'Don't copy data from xws worksheet
If ws.Name <> "xws" Then
'Storing first copied data in A1
If IsEmpty(Sheets("xws").[A1]) Then
rng.Copy Sheets("xws").Range("A" & Rows.Count).End(xlUp)
'Storing next copied data below previously filled cell
Else
rng.Copy Sheets("xws").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
End If
Next ws
End Sub
There is a problem with ws. referring, but whenever I put it before rng in if statements or before range (set rng = ...) I get errors.
Thanks in advance for any pointers.
You should be declaring rng for each ws inside the loop, like:
Sub exercise()
Dim ws As Worksheet
Dim rng As Range
For Each ws In ActiveWorkbook.Worksheets
'Finding last row in column B
Set rng = ws.Range("B" & ws.Rows.Count).End(xlUp) '<~~ Moved inside the loop
'Don't copy data from xws worksheet
If ws.Name <> "xws" Then
'Storing first copied data in A1
If IsEmpty(Sheets("xws").[A1]) Then
rng.Copy Sheets("xws").Range("A" & Rows.Count).End(xlUp)
'Storing next copied data below previously filled cell
Else
rng.Copy Sheets("xws").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
End If
Next ws
End Sub
As your code is now, rng will be pointing to the ActiveSheet at the time you run the macro, and your code will then copy the same cell on each iteration of the code.
I have a Macro however it doesnt seem to be working. I have a workbook which has multipul worksheets. I basically want to copy cells B1, G1, M94 all to a seperate "Summary" worksheet. Copied Cells to go to A4 B4 and C4 than if there is more A5, B5 and C5 and so on.
The coding i have is below. I have tried to make it so it only did it for one sheet but need it for about 10 sheets all with different names.
Sub SummurizeSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "17B CUNNINGHAM" Then
ws.Range("B1, G1, M94").Copy
Worksheets("Summary").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) _
.PasteSpecial (xlPasteValues)
End If
Next ws
End Sub
The problem you will have is you cannot copy/ paste a range the way you have tried to (multiple sections).This should work:
Sub SummurizeSheets()
Dim ws As Worksheet, wsSummary As Worksheet
Dim c As Range
Application.ScreenUpdating = False
Set wsSummary = Sheets("Summary")
' Set destination cell
Set c = wsSummary.Range("A4")
For Each ws In Worksheets
If ws.Name <> "17B CUNNINGHAM" And ws.Name <> "Summary" Then
ws.Range("B1").Copy
c.PasteSpecial (xlPasteValues)
ws.Range("G1").Copy
c.Offset(0, 1).PasteSpecial (xlPasteValues)
ws.Range("M94").Copy
c.Offset(0, 2).PasteSpecial (xlPasteValues)
' Move destination cell one row down
Set c = c.Offset(1, 0)
End If
Next ws
Application.ScreenUpdating = True
End Sub
I have used a destination cell to place the paste which you can then offset for the next row so you can use this for multiple sheets. Also excluded the Summary sheet from the For Each and reset the ScreenUpdating
As the title I tried this one, but it overwrites existing data, I am looking for something that
add the header row in all sheets moving the data down. I have got 50 sheets that's why I am asking :-)
Sub CopyToAllSheets()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("sheet1")
Sheets.FillAcrossSheets ws.Range("1:1")
End Sub
Thank you in advance
You could insert a line in each sheet before filling the headers:
Sub CopyToAllSheets()
Dim sheet As Worksheet
For Each sheet In Sheets
sheet.Rows("1:1").Insert Shift:=xlDown
Next sheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("sheet1")
Sheets.FillAcrossSheets ws.Range("1:1")
End Sub
I will be assuming that your header will be coming from another sheet. Recording a macro gives me:
Sub Macro4()
Sheets("Sheet1").Select
Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub
Cleaning it up gives:
Sub InsertOnTop()
Sheets("Sheet1").Rows("1:1").Copy
Sheets("Sheet2").Rows("1:1").Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub
Applying it safely across all sheets except the source sheet:
Sub InsertOnTopOfEachSheet()
Dim WS As Worksheet, Source As Worksheet
Set Source = ThisWorkbook.Sheets("Sheet1") 'Modify to suit.
Application.ScreenUpdating = False
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> Source.Name Then
Source.Rows("1:1").Copy
WS.Rows("1:1").Insert Shift:=xlDown
End If
Next WS
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Let us know if this helps.
I believe you will need to loop through each sheet and insert a blank row, or just use the range.insert method on each sheet. Perhaps something like:
Option Explicit
Sub CopyToAllSheets()
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
If Not WS.Name = "Sheet1" Then
If WorksheetFunction.CountA(WS.Rows(1)) > 0 Then _
WS.Rows(1).Insert
End If
Next WS
Worksheets.FillAcrossSheets Worksheets("Sheet1").Rows(1), xlFillWithAll
End Sub