I'm currently trying to copy and paste a dynamic range from one workbook to another in order to refresh an existing dashboard.
I've developed the code below, but continue to get error notifications on the italicized portion below:
Sub TransferData()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("C:\file1.xlsx")
Set y = Workbooks.Open("C:\file2.xlsx")
Set StartCell = Range("A1")
finalrow = x.Sheets("Worksheet Name").Cells(Rows.Count, 2).End(xlUp).Row
'Counts
FinalColumn = x.Sheets("Worksheet Name").Cells(1,
Columns.Count).End(xlToLeft).Column
*x.Sheets("Worksheet Name").Range(StartCell, Cells(FinalRow,
FinalColumn)).Copy*
y.Sheets("Worksheet Name").Range(Cells(1, 7), Cells(FinalRow,
FinalColumn)).Paste
End Sub
You have to declare the worksheet, which is the "parent" of Cells as well. Like this:
With x.Sheets("Worksheet Name")
.Range(StartCell, .Cells(finalrow, FinalColumn)).Copy
End With
With y.Sheets("Worksheet Name")
.Range(.Cells(1, 7)).PasteSpecial xlPasteAll
End With
Related
So I want to copy values from a certain range of cells from worksheet 1-workbook A to worksheet 1- workbook B .
I want to copy everything from the source worksheet: more specifically, every cell that has a value on it.
On the destination worksheet, there are specified cells for the values on source worksheet.
this is my code so far (it's bad, but i'm a noob at VBA!) :
Sub CopyRangeofCells()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("C:\test\template.xlsx")
Set y = Workbooks.Open("C:\test\finalfile.xlsx")
x.Sheets("RDBMergeSheet").Range("A1").Copy
y.Sheets("CW Fast").Range("A1").PasteSpecial
'Close x:
x.Close
End Sub
On my range, I want to do something like Range("A1:LastRow") or anything of the sort. How do I do it? Can I create a lastrow variable and then do ("A1:mylastrowvariable") ??
Hope you can help! VBA is so confusing to me, give me Java all day long! :P
Let's do it step-by-step:
Sub CopyRangeofCells()
Dim x As Workbook
Dim y As Workbook
Dim LastRow As Long
Set x = Workbooks.Open("C:\test\template.xlsx")
Set y = Workbooks.Open("C:\test\finalfile.xlsx")
With x.Sheets("RDBMergeSheet")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"
.Range("A1:A" & LastRow).Copy
End With
y.Sheets("CW Fast").Range("A1").PasteSpecial xlPasteValues
'Close x:
x.Close
End Sub
Something like this:
Sub CopyRangeofCells()
Dim x As Workbook
Dim y As Workbook
Dim LastRow as Long
Dim LastRowToCopy as Long
Set x = Workbooks.Open("C:\test\template.xlsx")
Set y = Workbooks.Open("C:\test\finalfile.xlsx")
LastRowToCopy = x.Sheets("RDBMergeSheet").Cells(x.Sheets("RDBMergeSheet").Rows.Count, "A").End(xlUp).Row
x.Sheets("RDBMergeSheet").Range("A1:A" & LastRowToCopy).Copy
'copy from A1 to lastrow
LastRow = y.Sheets("CW Fast").Cells(y.Sheets("CW Fast").Rows.Count, "A").End(xlUp).Row + 1 'find the last row
y.Sheets("CW Fast").Range("A" & LastRow).PasteSpecial xlPasteValues
'paste on the lastrow of destination + 1 (so next empty row)
x.Close
End Sub
I have the following code which will copy/paste some columns from "data" worksheet and pastes to the next empty column in to the column that i specify in the mastersheet called "KomKo".
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("data")
Set pasteSheet = Worksheets("KoMKo")
lRow = copySheet.Cells(copySheet.Rows.Count, 1).End(xlUp).Row
With copySheet.Range("BX2:BX" & lRow)
pasteSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
Now i would like to add an if condition for another column; which should say "if column U in Worksheet "data" has cell value "8636" then these values should be pasted to Column H in Worksheet "KomKo"(pastesheet); to the next row as i used the code above in the "with" part.
Else( If the value in Column H is not 8636) then it should paste the value inside this column to Column G at Worksheet "KomKo"(pastesheet) with same preferences as above again.
How can i do this ?
So, I've come up with a suggestion below using an if-then within a loop. I think it's close to what you want...
Sub try6()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim x As Range
Set ws = Worksheets("data")
Set ws2 = Worksheets("KomKo")
For Each x In ws.Range("C1:C100")
If x.Value = 8636 Then
ws2.Range("H:H").Value = ws.Cells(Rows.Count, "A").Value
ElseIf x <> 8636 Then
ws2.Range("G:G").Value = ws.Range(Rows.Count, "B").Value
End If
Next x
End Sub
Testing it, it took a while to execute. I'd say, set a dynamic range at something like A10000 and copy it directly without needing to necessarily test for whether there is a value in the range being copied.
You can also use the Select method for the purpose and copy the selection - from personal experience, I've had mixed success with it and I've seen people advise against using it here.
These are my .02, hope it helps! Cheers.
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)
Rename the sheet to the value of the drop down.
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
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
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
I am trying to dynamically generate a custom number of worksheets based on a template that we use regularly in excel using VBA.
I have created an "Overview" page where we can input a range which will be used to name the new worksheets but then would like to use a hidden "Master" worksheet to generate the content of these new worksheets.
My code below currently generates the correct number of pages based on the range AND copies our master template page but does not combine the two and leaves them in separate pages.
Sub test()
Dim MyNames As Range, MyNewSheet As Range
Set masterSheet = ThisWorkbook.Worksheets("Master")
Set MyNames = Range("A1:A6").CurrentRegion ' load range into variable
For Each MyNewSheet In MyNames.Cells ' loop through cell range
masterSheet.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy master template sheet
Sheets.Add.Name = MyNewSheet.Value
Next MyNewSheet
MyNames.Worksheet.Select ' move selection to original sheet
End Sub
As you can see, the code generates both the named (blank) worksheets AND copies my master worksheet which defaults to naming as "Master()".
So we just need to replace this line:
Sheets.Add.Name = MyNewSheet.Value
with this line:
ActiveSheet.Name = MyNewSheet.Value
Loop through the list and copy the sheet if the sheet does not already exist.
Sub CopyMaster()
Dim ws As Worksheet, sh As Worksheet
Dim Rws As Long, rng As Range, c As Range
Set sh = Sheets("Overview")
Set ws = Sheets("Master")
With sh
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range(.Cells(1, 1), .Cells(Rws, 1))
End With
For Each c In rng.Cells
If WorksheetExists(c.Value) Then
MsgBox "Sheet " & c & " exists"
Else:
ws.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = c.Value
End If
Next c
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
I have the following code:
Sub test()
Dim r As Range, rng As Range
Set r = Range("a6", Range("a6").End(xlDown))
For Each rng In r
If rng <> rng.Offset(-1) Then 'if range is not
Dim ws As Worksheet
Set ws = Worksheets.Add
ws.Name = rng
Else
End If
Next rng
End Sub
This would go through the range in A6 to AXX and create a worksheets for different names. I somehow can't figure out however how to copy the content of every row into every worksheet created.
So I want all the Ticker changes being copied into the new created worksheet ticker changes.
I know there is some way with the following:
Range(Cells(rng, 1), Cells(rng, 10)).Copy
But I don't know how to paste those to different worksheet.
Can someone please advice or guide. Thanks
Also when I try to run this macro it sometimes says:
That name is already taken try a different one.
However there is no worksheet with that name.
You only need to reference/specify the sheet that you want to use.
Try this (I included an inputbox to correct the name of the sheet if it is already taken :
Sub test_Nant()
Dim r As Range, rng As Range, ws As Worksheet, aWs As Worksheet
Set aWs = ActiveSheet
Set ws = Worksheets.Add
On Error GoTo SheetRename
ws.Name = "Changes list"
GoTo KeepLooping
SheetRename:
ws.Name = InputBox("Choose another name for that sheet : ", , rng.Value)
Resume Next
KeepLooping:
With aWs
Set r = .Range(.Range("a6"), .Range("a6").End(xlDown))
For Each rng In r
If rng <> rng.Offset(-1) Then 'if range is not
.Range(.Cells(rng.Row, 1), .Cells(rng.Row, 10)).Copy Destination:=ws.Range("A1")
Else
End If
Next rng
End With
End Sub