Posts by caasi6636

Hello,

My goal for this program is to copy and paste these groups onto every sheet in a workbook, and then replace certain cells with the groups if they have a key phrase.

However, when I run my code currently instead of pasting both of the groups it only pastes twice whichever one is selected first.

Any clues on how to help?
[VBA]Sub CopyGroups()
CopyShape1
CopyShape2

End Sub

Sub CopyShape2()

Dim X As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

For X = 2 To (WS_Count)


ActiveWorkbook.Worksheets(1).Shapes.Range(Array("Group 4")).Select

Selection.Copy

'Reference Sub Active Cell, Column 2

BlankRowActive X, 2

ActiveSheet.Paste

Next X
End Select

Application.CutCopyMode = False
End Sub

Sub CopyShape1()

Dim X As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

For X = 2 To (WS_Count)


ActiveWorkbook.Worksheets(1).Shapes.Range(Array("Group 1")).Select

Selection.Copy

'Reference Sub Active Cell, Column 1

BlankRowActive X, 1

ActiveSheet.Paste

Next X
End Select

Application.CutCopyMode = False

End Sub

Sub BlankRowActive(SheetNum As Integer, Column As Integer)

Dim lRow As Integer

lRow = ActiveWorkbook.Worksheets(SheetNum).Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

lRow = lRow + 1

Worksheets(SheetNum).Select

ActiveSheet.Cells(lRow, Column).Select

End Sub
[/VBA]

I figured it out! I accidentally started at (0,0) not (1,1).

Hello ad thank you. I am new to using VBA and have come across some issue trying to compile all data across a few sheets into a summary sheet. My data is not uniform, therefore there may be more rows on some sheets than on others, however to columns should be the same. I successfully coded acquiring the used dimensions for all the sheets, excluding the header. However I was unable to actually copy the data into my Summary Sheet. Any idea what I did wrong?

[VBA]Function SheetsDimensions() As Variant

Dim Dimensions(1 To 50, 1 To 50) As Variant
Dim WS_Count As Integer

Dim X As Integer

Dim Ix As Integer

Dim Jx As Integer

Ix = InputBox("Please Enter The Starting # of OFFSET For your Rows (Ex If You have Labelled Columns Or Rows, Number from the top)")

Jx = InputBox("Please Enter The Starting # of OFFSET For your Columns (Rare, but if you had labels on the left side)")

WS_Count = ActiveWorkbook.Worksheets.Count

Dim lRow As Long

Dim lCol As Long

Dim TotRow As Long

Dim TotCol As Long

lRow = 0
lCol = 0

For X = 1 To (WS_Count - 1)


TotRow = lRow + TotRow
'TotCol = lCol + TotCol


'This Sets Up The Dimensions Of Each Individual Sheet

lRow = ActiveWorkbook.Worksheets(X).Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

Dimensions(X, 1) = lRow - Ix

lCol = ActiveWorkbook.Worksheets(X).Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column

Dimensions(X, 2) = lCol - Jx

'Now I Am Going to Paste Each Of These Areas In The Final Sheet (Should Be Summary Sheet)

Dim i As Integer, j As Integer

For i = Ix To lRow

For j = Jx To lCol
Dim Act As Integer
Act = i + TotRow + 1

ActiveWorkbook.Worksheets(WS_Count).Cells(Act, j) = ActiveWorkbook.Worksheets(X).Cells(i, j)

Next j

Next i


Next X

Dim k As Integer, l As Integer

' A Sample Test to See if dimensions were properly acquired

For k = 1 To 10
For l = 1 To 2
Cells(k, l).Value = Dimensions(k, l)
Next l
Next k

SheetsDimensions = Dimensions

End Function
[/VBA]