VBA code for consolidating/transf data from multiple worksheets in one Template sheet

[roko_75]

hallo,

trying to make a vba code for consolidating/transfering data fm multiple sheets with different ranges into a template worksheet in same workbook.
Including IF statement for slecting the range to transfer fm each sheet for column A (starting from A10) if A10 onwards is not blank -then copy ranges A10:I10,A11:I11 untill A.. is blank.
And paste into template sheet starting C7 onward looping through all sheets in the workbook.
attached draft file.Ranges for transfer in different sheets are marked in yelow.
Last sheet is the template one.

tahnx a lot.

[Leith Ross]

Hello roko_75,

I have looked at your workbook, aside from the language differences, understand what you want to do. The problem I have is with the "Template" worksheet. It changes as I scroll up, down or sideways. The behavior is very odd. My attempts at trying to correct this have failed. Perhaps you can provide some insight on what is happening.

[roko_75]

Hello roko_75,

I have looked at your workbook, aside from the language differences, understand what you want to do. The problem I have is with the "Template" worksheet. It changes as I scroll up, down or sideways. The behavior is very odd. My attempts at trying to correct this have failed. Perhaps you can provide some insight on what is happening.

hello Ross,

thanx a lot for the quick feedback.
Some of the language is Bulgarian.Sheets are seperate loading orders that need to be transfered in one cargo manifest at the end.
I have looked over template have no issues.
Basiclly a new blank sheet can be inserted as template I will sort out headers lately.
Just transfer of data fm sheets where not blank A:I to start in template fm C7 on.
I have tried with macro recorder and then changing the VBA my self but can not quite sort the IF statements and the loop.

thanx a lot appreciated

rgds
rosen

[p45cal]

The attached contains this macro:

Sub blah()
Dim rngDataEnd As Range
Sheets("Template cm").Copy after:=Sheets(Sheets.Count)
Set shtDestn = ActiveSheet
Set Destn = shtDestn.Range("C7")
For Each sht In Sheets
  With sht
    'If Not (sht Is shtDestn) And sht.Name <> "Template cm" And InStr(sht.Name, "Template") = 0 Then
    If InStr(sht.Name, "Template") = 0 Then
      Set rngDataEnd = .Range("B:B").Find("???? ??????????", .Range("B10"), xlFormulas, xlWhole, searchformat:=False)
      If Not rngDataEnd Is Nothing Then
        Set rngToCopy = .Range(.Range("A10"), .Cells(rngDataEnd.Row - 1, "I"))
        
        'either:
        'rngToCopy.Copy Destn
        'or:
        Destn.Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value = rngToCopy.Value
        
        
        Set Destn = Destn.Offset(rngToCopy.Rows.Count)
      End If
    End If
  End With
Next sht
End Sub

Note the line containing the red:

Set rngDataEnd = .Range("B:B").Find("???? ??????????", .Range("B10"), xlFormulas, xlWhole, searchformat:=False)

where the red text works because it happens to pattern-match the correct cell, but it should really be what an internet translation tool tells me means auto compositions.
You need to adjust the code to replace all those question marks with what's in cell B11 on sheet 73. I can't do it here because of locale differences.

The code also has an either:/or: choice in the middle; one copies values and formats, the other copies values only. Enable/disable the appropriate lines.

[roko_75]

Hi,

really thanx a lot -have done the adjustments and it is working perfectly .
much appreciated.

rgds
Rosen

[Paul_Hossler]

@Leith — Is your Scroll Lock on?