I have been looking at several related questions and cant seem to get a working solution for my workbook. I am trying to make a "add new section" Macro/Button that will copy a range of data and paste it to the last row of the active worksheet.
My current code is as follows:
Sub EnterClientSection()
'
' EnterClient Section Macro
'
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Zdata")
Set pasteSheet = ActiveSheet
copySheet.Range("A70:G81").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
'
When I run the macro, it simply selects the last row on the current worksheet but doesnt seem to copy or paste anything.
"Zdata" is where the range of cells I would like to copy is stored.
Thank you for any with this :)
Related
I've been working from this article to try and consolidate data from multiple worksheets into a single summary worksheet. I've nearly got it working but I'm struggling to alter the destination worksheet.
I'm trying to have the consolidated data appear into cell B4 on the Consolidated Tracker sheet.
With CopyRng
Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")
Set myRange = DestSh.Range("B4")
End With
Problem is myRange is always empty and nothing is copied over.
No error, seems to execute f8 as expected without copying anything over.
Full Code for reference:
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
' Find the last row with data on the summary worksheet.
Last = LastRow(DestSh)
' Specify the range to place the data.
Set CopyRng = sh.Range("B4:B50")
' This statement copies values
With CopyRng
Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")
Set myRange = DestSh.Range("B4")
End With
'End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(4, 2)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
The issue is that the code never actually execute any type of command to move the data. The code only sets variables.
Look at the modified code below, specifically the last line before the End With.
' Specify the range to place the data.
Set CopyRng = sh.Range("B4:B50")
' This statement copies values
With CopyRng
Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")
DestSh.Range("B4").Resize(CopyRng.Rows.Count,1).Value = CopyRng.Value
End With
Here's how my sheet works:
I paste information from Amazon into one sheet. This includes the amount, which in this case, is $127.02.
I use a macro to move this information to the next sheet so it's organized in a database type thing. However, when I run the macro, it is taking 127.02 and changing it to 27.02... Spooky.
I am certain that it is pasting as 127.02 and not 27.02. The change only occurs when the macro is run and it is moved.
Both the cell it is originally pasted into and the cell it is moved to are in general format.
Here's the VBA:
Sub ToCurrent()
'Rename sheets
Dim NextRow As Long
Dim wsPaste As Worksheet: Set wsPaste = Sheets("AMPaste")
Dim wsCurrent As Worksheet: Set wsCurrent = Sheets("AMCurrent")
'Paste AMPaste to AMCurrent
NextRow = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row + 1
wsPaste.Range("A3:F3").Copy
wsCurrent.Range("A" & NextRow).PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
'Clear AMPaste Worksheet
Sheets("AMPaste").Range("A4:E200").Clear
'Remove pics from AMPaste Worksheet
Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic
'Add text to A4
Range("$A$4").Value = "'Paste Case Here"
Range("$A$4").Font.Bold = True
End Sub
Any help is much appreciated. I'm not sure why it would be dropping the 1 and as far as I know this is the only number it's done it to.
Thank you!
I am needing to copy cells B3:W400 from multiple sheets (will have varying names each time it is run) and paste values into "CombinedPlans", appending each new selection under the last. I need 3 sheets excluded from the code: IBExport, MonthlyIBs, and Combined Plans.
A lot of googling with trial and error has given me the following code, which I got to work in my "practice" workbook. Now that I have put it into my production workbook, it is no longer copying any sheets. It just skips straight to the message box. What am I doing wrong?
Sub consolidatetest()
Sheets("CombinedPlans").Select
Range("B3:W1048576").Select
Selection.ClearContents
Dim J As Integer
Dim sh As Worksheet
Const excludeSheets As String = "QBExport,MonthlyIBs,CombinedPlans"
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, Split(excludeSheets, ","))) Then
Application.GoTo Sheets(sh.Name).[b3]
Range("B3:W400").Select
Selection.Copy
Worksheets("CombinedPlans").Activate
Range("B1048576").End(xlUp).Offset(rowOffset:=1, columnOffset:=0).PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
MsgBox "Complete!"
End Sub
This should work. If you have still problems, make sure that the Sheet CombinedPlans is indeed so named.
Sub consolidatetest()
Dim wb As Workbook
Dim sh_CombPlans As Worksheet
Set wb = ThisWorkbook
Set sh_CombPlans = wb.Sheets("CombinedPlans")
sh_CombPlans.Range("B3:W1048576").ClearContents
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "QBExport", "MonthlyIBs", "CombinedPlans":
'Do Nothing
Case Else
sh.Range("B3:W400").Copy
sh_CombPlans.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Select
Next
Application.CutCopyMode = False
MsgBox "Complete!"
End Sub
I have a workbook named Test and wrote a macros with the code below. It worked fine, but when I added it to my personal workbook, the code gave an error on line Set ws = ThisWorkbook.Sheets("Sheet1").
Subscript out of range.
I moved the code from a module to the Sheet1 on the Personal Workbook and then to the ThisWorkbook. Nothing helped. If you could give any sort of advice of what I could try that would be greatly appreciated.
Sub KeepOnlyAtSymbolRows()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("E1:E" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=1, Criteria1:="<>*#*"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
' turn off the filters
ws.AutoFilterMode = False
End Sub
Do you specifically wish to refer to the sheet "Sheet1" in the currently open workbook?
If so, use the line below
Set ws = ActiveWorkbook.Worksheets("Sheet1")
And if you simply wish to refer to the current sheet, use
Set ws = ActiveSheet
And if you wish to simply target the first sheet, whatever its name,
Set ws = ActiveWorkbook.Worksheets(1)
The way the code is currently written, it seems to be referring to "Sheet1" in the personal workbook and not necessarily the one currently active with the user.
I recorded this macro:
Sheets("Sheet1").Select
Range("D4:E4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ALB3").Select
Range("C1").Select
ActiveSheet.Paste
I want to make a loop to repeat the process.
From range D4:E4 to D200:E200 when do select
To paste that on respective sheet name from ALB3 to ALB196.
My data in sheet 1.
Column a is sheets name, column d4 and e4, is the data that I want to paste on every sheet already created.
If you're trying to copy a range from one sheet to another, you don't need a loop and you don't need to select. You can use copy syntax that doesn't use your clipboard.
Try this:
Sub CopyRangeToAnotherSheet()
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets("Sheet2")
source.Range("D4:E200").Copy target.Range("ALB3")
End Sub
To copy the source range to all sheets in the workbook except the source worksheet, try this:
Sub CopyToAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
CopyRangeToAnotherSheet (ws.Name)
Next
End Sub
Sub CopyRangeToAnotherSheet(targetName As String)
Dim source As Worksheet
Dim target As Worksheet
Set source = ActiveWorkbook.Sheets("Sheet1")
Set target = ActiveWorkbook.Sheets(targetName)
If target.Name <> source.Name Then
source.Range("D4:E200").Copy target.Range("ALB3")
End If
End Sub