I have an excel with different sheets and same formats. Is there any plugin available to combine all sheets into a "Merged" sheet? Any help is truly appreciated
you can use vba,
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Merged"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Related
Newbie here! I have an action which I'd like to repeat, for specific workbooks or specific worksheets.
Is there a way to do it without copy and pasting the whole code for the 2nd, 3rd etc worksheets?
Only the workbook and the worksheet names change. other actions (e.g. copy paste) remains the same.
Although there's a "For Each loop", but I don't know how to do it in a way that allows me to specify which worksheets exactly.
For example, I'm
Step 1: copying data from workbook "Red" sheet "Apple". paste into output
workbook.
Repeat action. Step 2: copying data from workbook "Yellow" sheet "Banana". paste into
same output workbook.
Here's my code if anyone could kindly advise. VBA newbie here thank you!
Sub CopyPastefromOtherWB()
Range("B13").Select
'Activate WB1
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Red"
Worksheets("Apple").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("B13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'HERE IS WHERE THE REPEAT HAPPENS. Activate WB2
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Yellow"
Worksheets("Banana").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("C13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
End Sub
Please see How to avoid using Select in Excel VBA.
Sub CopyPastefromOtherWB(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetCell As Range)
With Workbooks.Open(FromPath)
With .Worksheets(FromSheetName)
Dim c As Range
Set c = .Rows(1).Find("Mar", LookAt:=xlWhole).Offset(1, 0)
TargetCell.Resize(c.Rows.Count, 1).Value = .Range(c, c.End(xlDown)).Value
End With
.Close False
End With
End Sub
With Workbooks.Open("C:\Users\Desktop\My macro projects\OutputWB").Worksheets("Sheet1")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Red", "Apple", .Range("B13")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Yellow", "Banana", .Range("C13")
End With
After months of learning, I developed a solution, feel free to use the code below and tweak it to your needs. This solution is for a set area of cells.
Sub copypaste_adhoc()
Dim inputfile As Workbook
Set inputfile = Workbooks.Open("c:\path\workbook")
Dim arrSht, i
arrSht = Array("worksheet1", "worksheet2")
For i = LBound(arrSht) To UBound(arrSht)
With Worksheets(arrSht(i))
.Range("A31:Z31").Copy
ThisWorkbook.Sheets("Sheet1").Cells(Sheet5.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Next i
Application.CutCopyMode = False
Sheet5.Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub
I have a list of names vertically consisting of 500+ rows on sheet1 as follow
Bill no (002, 003) Name (john, james ) Amount (455, 55)
whereas, I have a bill invoice shaped format on sheet2 and need to substitute the sheet 1 data on it.
the below vba code works perfectly for one particular row (A3:C3) but the problem im facing is that the list on sheet1 has 500 plus rows.
so kindly help me with an alternative where I can mouse click a random cell (A3) and the vba code copies the entire row (A3:C3) from sheet1 to sheet 2 to their respective places
Sub Macro13()
'Macro13 Macro
Range("A3").Select
Selection.Copy
Sheets("Sheet3").Select
Range("C4").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(17, 3).Range("A1").Select
ActiveSheet.Paste
Range("c4").Select
End Sub
Please, test the next code:
Sub CopyCellsSpecificPlaces()
Dim sh2 As Worksheet, sh3 As Worksheet, aC As Range
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Set aC = ActiveCell
If (Not aC.Parent Is sh2) Or (aC.Column <> 1) Then
MsgBox "You must run the code after selecting a cell in A:A column of ""Sheet1""...": Exit Sub
End If
sh3.cells(4, "C").Value = aC.Value
sh3.cells(4, "G").Value = aC.Offset(0, 1).Value
sh3.cells(21, "J").Value = aC.Offset(0, 2).Value
End Sub
you can refer to the following code and modify as you want.
Sub Macro13()
Sheets("Sheet2").Range("A3").Copy
Sheets("Sheet3").Range("C4").Paste
Sheets("Sheet2").Range("B3").Copy
Sheets("Sheet3").Range("A5").Paste
Sheets("Sheet2").Range("C3").Copy
Sheets("Sheet3").Range("D18").Paste
End Sub
I have 4 sheets in my workbook . I want to combine all the data in new worksheet . I got the code which I written below. But now I don't want to display sheet1 data in new sheet. Have attached the worksheet for your reference . Thanks in Advance!!!!
sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Only minor changes to your code will make this work:
Sub Combine()
Dim Lastrow As Integer
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(3).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 3 To Sheets.Count
Sheets(J).Activate
' First delete the empty rows
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:L" & Lastrow).Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' Then select the region as a table
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
So I'm trying to figure out how I can setup a macro that will take the data that I enter into a form on one sheet then log it into a log in another sheet. It will log it but my big problem is that it needs to go to the next line and I can't quite figure out the code for it. Here is what my code looks like:
Sub Appt()
'
' Appt Macro
'
'
Range("E4").Select
Selection.Copy
Sheets("Appointments").Select
Range("G7").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Appointments").Select
Range("D7").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Appointments").Select
Range("E7").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("E10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Appointments").Select
Range("F7").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("E12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Appointments").Select
Range("H7").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("E4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E6").Select
Selection.ClearContents
Range("E8").Select
Selection.ClearContents
Range("E10").Select
Selection.ClearContents
Range("E12").Select
Selection.ClearContents
End Sub
To get the next empty row on Sheets("Appointments") you would use this formula to get the row number:
tRw = Sheets("Appointments").Range("D" & Rows.count).End(xlUp).Offset(1).Row
This assumes that there is nothing in column D below what you are pasting.
It is apparent that you used the macro recorder, and this is a great way to learn. But using the .select so much will slow things down and is unneeded.
To get around that declare the sheets as variables and then one line for each copy paste is needed.
Sub APPT()
Dim oWs As Worksheet
Dim tWs As Worksheet
Dim tRw As Long
Set oWs = Sheets("Data Entry")
Set tWs = Sheets("Appointments")
tRw = tWs.Range("D" & Rows.count).End(xlUp).Offset(1).Row
With oWs
.Range("E4").copy tWs.Range("G" & tRw)
.Range("E6").copy tWs.Range("D" & tRw)
.Range("E8").copy tWs.Range("E" & tRw)
.Range("E10").copy tWs.Range("F" & tRw)
.Range("E12").copy tWs.Range("H" & tRw)
.Range("E4").ClearContents
.Range("E6").ClearContents
.Range("E8").ClearContents
.Range("E10").ClearContents
.Range("E12").ClearContents
End With
End Sub
For other methods of finding the next row look at Siddharth Rout's answer here.
And as BruceWayne stated in his comment, this is a great reference as to why/how to avoid using .select
It's best to avoid the user's clipboard and to assign the values directly:
Sub Appt()
Dim n&, v
v = [transpose(offset('data entry'!e4,{0;2;4;6;8},))]
With Sheets("appointments")
n = .Range("d" & .Rows.Count).End(xlUp).Row
.[g1].Offset(n) = v(1)
.[d1].Offset(n) = v(2)
.[e1].Offset(n) = v(3)
.[f1].Offset(n) = v(4)
.[h1].Offset(n) = v(5)
End With
Sheets("data entry").Range("e4,e6,e8,e10,e12").ClearContents
End Sub
I have a really weak experience working with VBA, but now faced an issue where it is really required.
I need to copy cell's value from multiple worksheets (besides "Summary") into one worksheet, but facing a problem. When running a macro, I get around 30 lines with the values I need, but all 30 values belong to the same worksheet. Seems like the loop is running only around 1 worksheet. Could you help me finding the mistake in the code?
Sub CopyTotalSalesPrice()
For Each Worksheet In ActiveWorkbook.Worksheets
If Worksheet.Name <> "Summary" Then
Worksheet.Cells(Rows.Count, 7).End(xlUp).Select
End If
If Selection.Value > "0" Then
Selection.Copy
Worksheets("Summary").Cells(Rows.Count, 6).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
Range("D4").Select
Selection.Copy
Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
End If
Next Worksheet
Worksheets("Summary").Select
End Sub
when using Cells(Rows.Count, 7).End(xlUp).Select and everything else, they refer to the current sheet. So you either put in front of them Worksheet.Cells(Rows.Count, 7).End(xlUp).Select or you activate the sheet first with Worksheet.Activate
or you can just do as follow:
Sub CopyTotalSalesPrice()
For Each Worksheet In ActiveWorkbook.Worksheets
With Worksheet
If .Name <> "Summary" Then
.Cells(Rows.Count, 7).End(xlUp).Copy Destination:=Worksheets("Summary").Cells(Rows.Count, 6).End(xlUp).Offset(2, 0)
.Range("D4").Copy Destination:=Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(2, 0)
End If
End With
Next Worksheet
Worksheets("Summary").Select
End Sub
Try this:
Sub CopyTotalSalesPrice()
For Each Worksheet In ActiveWorkbook.Worksheets
If Worksheet.Name <> "Summary" Then
Worksheet.Select
Worksheet.Cells(Worksheet.Rows.Count, 7).End(xlUp).Select
End If
If Selection.Value > "0" Then
Selection.Copy
Worksheets("Summary").Cells(Worksheet.Rows.Count, 6).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
Range("D4").Select
Selection.Copy
Worksheets("Summary").Cells(Worksheet.Rows.Count, 4).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
End If
Next Worksheet
Worksheets("Summary").Select
End Sub
I replaced this Cells(Rows.Count, 7).End(xlUp).Select with Worksheet.Cells(Worksheet.Rows.Count, 7).End(xlUp).Select