I want to copy a range between sheets using for..next with step, but I'm not fluent with using the for..next statement. I have recorded the step with macro, here is the code:
Sub Macro1()
Range("A2:A22").Select
Selection.Copy
Sheets("Sheet4").Select
ActiveSheet.Paste
Sheets("db_pivot").Select
Range("C2:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("db_pivot").Select
Range("E2:E22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("C2").Select
ActiveSheet.Paste
Sheets("db_pivot").Select
Range("G2:G22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Range("D2").Select
ActiveSheet.Paste
End Sub
Could you convert the code with for..next statement with step?
You can use the Uninon to group your non-continous Columns in one Range.
Option Explicit
Sub Macro1()
Dim DBPivotSht As Worksheet
Dim Sht4 As Worksheet
Dim UnionRng As Range
' get used to allways define your worksheet objects
Set DBPivotSht = Worksheets("db_pivot")
Set Sht4 = Worksheets("Sheet4")
With DBPivotSht
Set UnionRng = Union(.Range("A2:A22"), .Range("C2:C22"), .Range("E2:E22"), .Range("G2:G22"))
End With
' copy the entire Union range and paste in "Sheet4"
UnionRng.Copy Destination:=Sht4.Range("A2")
End Sub
Without FOR ... NEXT statement, I propose this code
With Sheets("db_pivot")
.Range("A2:A22").Copy Sheets("Sheet4").Range("A1")
.Range("C2:C22").Copy Sheets("Sheet4").Range("B2")
.Range("E2:E22").Copy Sheets("Sheet4").Range("C2")
.Range("G2:G22").Copy Sheets("Sheet4").Range("D2")
End With
HTH
Jon
Related
This is a screenshot of my excel doc.
I want to apply filters based on values: Bimbo Mexico, Bimbo Canada and copy and paste the values(from column A & B) in a new sheet. I want to do this using macro as I am building a template for a client. Is there a way to do this? I know it can be done manually using filters manually but I want it to be based on a macro
I want the output like this:
I used recording macro and this is the macro I got,
Sub RecordedMacro()
'
' RecordedMacro Macro
'
' Keyboard Shortcut: Ctrl+l
'
Sheets("report").Select
Range("C1").Select
ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:="Barcel"
Columns("L:L").Select
Selection.Copy
Sheets("SkuRounds").Select
Columns("S:S").Select
ActiveSheet.Paste
Sheets("report").Select
ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
"Bimbo Canada"
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("SkuRounds").Select
Columns("T:T").Select
ActiveSheet.Paste
Sheets("report").Select
ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
"Bimbo Latin Centro"
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("SkuRounds").Select
Columns("U:U").Select
ActiveSheet.Paste
Sheets("report").Select
ActiveSheet.Range("$A$1:$S$1001").AutoFilter Field:=3, Criteria1:= _
"Bimbo México"
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("SkuRounds").Select
Columns("V:V").Select
ActiveSheet.Paste
End Sub
I am copying data from sheet(report) to sheet(skurounds)
Give this a try:
Sub tgr()
Dim wb As Workbook
Dim wsReport As Worksheet
Dim wsSKU As Worksheet
Dim dictUnqCompanies As Object
Dim aCompanies As Variant
Dim vCompany As Variant
Dim lDestCol As Long
Set wb = ActiveWorkbook
Set wsReport = wb.Sheets("report")
Set wsSKU = wb.Sheets("skurounds")
Set dictUnqCompanies = CreateObject("Scripting.Dictionary")
lDestCol = wsSKU.Columns("S").Column
'Clear previous results
wsSKU.Range(wsSKU.Cells(1, "S"), wsSKU.Cells(1, wsSKU.Columns.Count)).EntireColumn.Clear
With wsReport.Range("C2", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
If .Row < 2 Then Exit Sub 'No data
If .Rows.Count = 1 Then
'Only 1 row of data
wsSKU.Cells(1, lDestCol).Value = .Value
.Parent.Cells(.Row, "L").Copy wsSKU.Cells(2, lDestCol)
Exit Sub
Else
aCompanies = .Value
End If
End With
For Each vCompany In aCompanies
If Not dictUnqCompanies.exists(vCompany) Then
dictUnqCompanies.Add vCompany, vCompany
With wsReport.Range("C1", wsReport.Cells(wsReport.Rows.Count, "C").End(xlUp))
.AutoFilter 1, vCompany
wsSKU.Cells(1, lDestCol).Value = vCompany
Intersect(.Parent.Columns("L"), .Offset(1).EntireRow).Copy wsSKU.Cells(2, lDestCol)
lDestCol = lDestCol + 1
.AutoFilter
End With
End If
Next vCompany
End Sub
I am attempting to create a macro that will pull data from several sheets and display them in an 'OVERVIEW' sheet.
At the moment I have the following:
Sheets("Sheet1).Select
ActiveCell.Range("A1:G7").Select
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveCell.Range("A1:G7").Select
Application.CutCopyMode = False
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Offset(7, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Range("A1:G2").Select
Application.CutCopyMode = False
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Offset(7, 0).Range("A1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-12
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Unfortunately, this currently only copies the data from the first sheet. I would much rather have something along the lines of the following pseudo code
sub COPY1()
Selection = []
curentRow = 1
while(notEmpty(cell(AcurentRow)))
Selection.add(curentRow)
curentRow++
return Selection
End Sub
sub PASTE1(selection)
curentRow=1
while(notEmpty(cell(AcurentRow)))
curentRow++
paste(selection)
End Sub
You can loop through the sheets, and it will skip over "OVERVIEW"
Sub Button1_Click()
Dim ws As Worksheet, sh As Worksheet, LstRw As Long
Set ws = Sheets("OVERVIEW")
For Each sh In Sheets
If sh.Name <> ws.Name Then
With sh
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:G" & LstRw).Copy
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
End If
Next sh
Application.CutCopyMode = False
End Sub
sub copy_to_overview()
currentRow = 1
while (notempty(cell(currentrow))
currentrow.copy
sheet("overwiev").currentrow.paste
currentrow = currentrow + 1
wend
end sub
I am trying to create a code that allows me to paste a selected range of data and paste it into Book2 in the first blank cell in Column A, starting from A1.
This is what I've got so far:
Sub Macro 1 ()
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Book2.xlsm").Activate
**CurrentRow = Range("A1").End(xlDown).Offset(1, 0).Row**
ActiveSheet.Paste
End Sub
I believe the trouble is the line with asterisks (**).Can someone help me rewrite this line/code so the copied data can paste in the first available cell from A1 down? (Up won't work since i have filled in cells further down the chart). Right now the code is pasting the data in whatever cell is selected :(
Thank you for your help everyone.
Try this out:
Dim book2 As Excel.Window
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("Book2").Activate
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
You could work more directly with ranges (without Select) as below:
Sub Better()
Dim Wb As Workbook
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range(ActiveCell, ActiveCell.End(xlToRight))
Set rng1 = Range(rng1, rng1.End(xlDown))
On Error Resume Next
Set Wb = Workbooks("book2.xlsm")
On Error GoTo 0
If Wb Is Nothing Then Exit Sub
Set rng2 = Wb.Sheets(1).Columns(1).Find("*", Wb.Sheets(1).[a1], , , xlByRows, xlPrevious)
If rng2 Is Nothing Then Set rng2 = Wb.Sheets(1).[a1]
rng1.Copy rng2.Offset(1, 0)
End Sub
I would like to copy the data from 'Sheet1' ($A:$N ; may fluctuate), select the range of the data and paste it in 'Sheet3'.
I also need to copy the data from 'Sheet2' without the first row (same headers as 'Sheet1') and paste it underneath the data of 'Sheet1' that is now in 'Sheet3'.
Sub CopyPaste()
Sheets("PC_VIEWS").Select
Range("A1:Q231").Select
Selection.Copy
Sheets("PC_LTC_VIEWS").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Selection.End(xlDown).Select
Range("A232").Select
Sheets("LTC_VIEWS").Select
Range("A1").Select
Application.CutCopyMode = False
Range("A1:M1264").Select
Selection.Copy
Sheets("PC_LTC_VIEWS").Select
ActiveSheet.Paste
End Sub
I am open to other solutions!
This code is enough. Try it.
Public Sub CopyAndPaste()
Dim firstRowCount, secondRowCount As Integer
'Copy from "PC_VIEWS" sheet.
Sheets("PC_VIEWS").Select
'Getting the last row from "PC_VIEWS" sheet.
firstRowCount = Range("A:Q").SpecialCells(xlLastCell).row
Range("A1:Q" & firstRowCount).Select
Selection.Copy
'Paste to "PC_LTC_VIEWS" sheet.
Sheets("PC_LTC_VIEWS").Select
Range("A1").Select
ActiveSheet.Paste
'Reset clipboard
Application.CutCopyMode = False
'Copy from "LTC_VIEWS" sheet.
Sheets("LTC_VIEWS").Select
'Getting the last row from "LTC_VIEWS" sheet.
secondRowCount = Range("A:Q").SpecialCells(xlLastCell).row
Range("A2:Q" & secondRowCount).Select
Selection.Copy
'Paste to "PC_LTC_VIEWS" sheet.
Sheets("PC_LTC_VIEWS").Select
Range("A" & firstRowCount + 1).Select
ActiveSheet.Paste
'Reset clipboard
Application.CutCopyMode = False
End Sub
Background:
I'm recording a macro in Excel that transfers data between three different workbooks that are all open at the same time (I'm recording it and then going into the code and fixing any bugs because I have zero experience with coding).
Problem:
Two of the workbooks will always be used while the third changes (ex. RFQ_1234, RFQ_1235). The macro works great, except each time I use it, I have to debug it and re-enter the name of the third workbook. How do I change my code so that it references the 3rd workbook without using a specific name?
Disclaimer:
I know .select is super slow, I don't care. It just needs to work. Also, I know very little about coding, so please explain even the smallest details.
Example of code:
Windows("RFQ_14446.xlsm").Activate
Range("J51").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Changing as little of your code as possible (as requested!)...
Sub Tester()
Dim wbName As String
wbName = GetRfqWbName("RFQ_")
If Len(wbName) = 0 Then
MsgBox "Didn't find the RFQ workbook!"
Exit Sub
End If
Windows(wbName).Activate
Range("J51").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B1").Select
ActiveSheet.Paste
Windows(wbName).Activate
Range("D27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Windows(wbName).Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
End Sub
'get the name of the first workbook which begins with sName...
Function GetRfqWbName(sName As String) As String
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name Like sName & "*" Then GetRfqWbName = wb.Name
Exit For
Next wb
End Function
EDIT: here's an improved version of the Tester sub above
Sub Tester2()
Dim wbName As String, shtSrc As Worksheet, shtDest As Worksheet
wbName = GetRfqWbName("RFQ_")
If Len(wbName) = 0 Then
MsgBox "Didn't find the RFQ workbook!"
Exit Sub
Else
'for example: you can substitute the sheet names instead
Set shtSrc = Workbooks(wbName).Sheets(1)
Set shtDest = Workbooks("Transfer Template.xlsm").Sheets(1)
End If
shtSrc.Range("J51").Copy shtDest.Range("B1")
shtSrc.Range("D27").Copy shtDest.Range("B2")
shtSrc.Range("D5").Copy shtDest.Range("B3")
End Sub
You can reference it by index or activesheet.
Dim ws as Excel.Worksheet
ws = Workbook.ActiveSheet
ws.Cell(A1).Value = "SomeValue"
Or you can use the index.
Set ws = ExcelApplication.Worksheets(1)